时间戳

首页 > 解决方案 > 如何通过更改在用户表单中循环？

excel - 如何通过更改在用户表单中循环？

问题描述

我有这个漂亮的代码字符串，可以在用户窗体中一次在一个文本框中完成我需要的操作...有没有办法通过 24 个不同的文本框的值更改来循环它？

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim DateStr As String
With Me.TextBox1
Select Case Len(.Value)
Case 4    ' e.g., 9298 = 2-Sep-1998
    DateStr = Left(.Value, 1) & "/" & _
              Mid(.Value, 2, 1) & "/" & Right(.Value, 2)
Case 5    ' e.g., 11298 = 12-Jan-1998 NOT 2-Nov-1998
    DateStr = Left(.Value, 1) & "/" & _
              Mid(.Value, 2, 2) & "/" & Right(.Value, 2)
Case 6    ' e.g., 090298 = 2-Sep-1998
    DateStr = Left(.Value, 2) & "/" & _
              Mid(.Value, 3, 2) & "/" & Right(.Value, 2)
Case 7    ' e.g., 1231998 = 23-Jan-1998 NOT 3-Dec-1998
    DateStr = Left(.Value, 1) & "/" & _
              Mid(.Value, 2, 2) & "/" & Right(.Value, 4)
Case 8    ' e.g., 09021998 = 2-Sep-1998
    DateStr = Left(.Value, 2) & "/" & _
              Mid(.Value, 3, 2) & "/" & Right(.Value, 4)
Case Else
    Exit Sub
End Select
.Value = DateStr
End With
End Sub

标签： excelvbaloopsonchange

解决方案

在表单后面的代码中：（不适用于mac）

Private AllControls() As New CatchEvents

Private Sub UserForm_Initialize()
Dim j As Long
ReDim AllControls(Controls.Count - 1)
    For j = 0 To Controls.Count - 1
    AllControls(j).Item = Controls(j)
    Next
End Sub

Private Sub UserForm_Terminate()
Dim j As Long
  For j = LBound(AllControls) To UBound(AllControls)
          AllControls(j).Clear
      Next j
      Erase AllControls
End Sub

然后将下面的代码复制到记事本并保存为whatever**.cls** 保存后，将此文件（类模块）导入您的VBA项目。您现在已经“挂钩”了所有控件的退出事件并在 TextBox-exit 上执行操作：（由于属性，此代码在直接粘贴到 VBA 项目时不会运行）

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CatchEvents"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Type GUID
      Data1 As Long
      Data2 As Integer
      Data3 As Integer
      Data4(0 To 7) As Byte
End Type

#If VBA7 And Win64 Then
      Private Declare PtrSafe Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal punk As stdole.IUnknown, _
              ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, ByRef pdwCookie As Long, _
              Optional ByVal ppcpOut As LongPtr) As Long
#Else
     Private Declare Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal punk As stdole.IUnknown, ByRef riidEvent As GUID, _
              ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As Long) As Long
#End If

Private EventGuide As GUID
Private Ck As Long
Private ctl As Object
Private CustomProp As String

Public Sub ConnectAllEvents(ByVal Connect As Boolean)
      With EventGuide
          .Data1 = &H20400
          .Data4(0) = &HC0
          .Data4(7) = &H46
      End With
      ConnectToConnectionPoint Me, EventGuide, Connect, ctl, Ck, 0&
End Sub

Public Property Let Item(Ctrl As Object)
      Set ctl = Ctrl
      Call ConnectAllEvents(True)
End Property

Public Sub Clear()
      If (Ck <> 0) Then Call ConnectAllEvents(False)
      Set ctl = Nothing
End Sub

Public Sub CtlExit(ByVal Cancel As MSForms.ReturnBoolean)
Attribute CtlExit.VB_UserMemId = -2147384829
Dim DateStr As String
If TypeName(ctl) = "TextBox" Then 'every exit event is catched, only use TextBox
With ctl
    Select Case Len(.Value)
        Case 4    ' e.g., 9298 = 2-Sep-1998
            DateStr = Left(.Value, 1) & "/" & _
            Mid(.Value, 2, 1) & "/" & Right(.Value, 2)
        Case 5    ' e.g., 11298 = 12-Jan-1998 NOT 2-Nov-1998
            DateStr = Left(.Value, 1) & "/" & _
            Mid(.Value, 2, 2) & "/" & Right(.Value, 2)
        Case 6    ' e.g., 090298 = 2-Sep-1998
            DateStr = Left(.Value, 2) & "/" & _
            Mid(.Value, 3, 2) & "/" & Right(.Value, 2)
        Case 7    ' e.g., 1231998 = 23-Jan-1998 NOT 3-Dec-1998
            DateStr = Left(.Value, 1) & "/" & _
            Mid(.Value, 2, 2) & "/" & Right(.Value, 4)
        Case 8    ' e.g., 09021998 = 2-Sep-1998
            DateStr = Left(.Value, 2) & "/" & _
            Mid(.Value, 3, 2) & "/" & Right(.Value, 4)
        Case Else
            Exit Sub
    End Select
    .Value = DateStr
End With
End If
End Sub

推荐阅读