Как я могу сделать это в пользовательской форме путем изменения? - PullRequest
Новая
       13

Как я могу сделать это в пользовательской форме путем изменения?

0 голосов
/ 16 ноября 2018

У меня есть эта изящная строка кода, которая делает то, что мне нужно, в одном текстовом поле за раз в пользовательской форме ... Есть ли способ зациклить его при изменении значения через 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

1 Ответ

0 голосов
/ 16 ноября 2018

в вашем коде за вашей формой: (не работает на 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

, а затем скопируйте приведенный ниже код в блокнот и сохраните его как угодно **. Cls ** После сохранения импортируйте этот файл (класс-модуль) в ваш проект VBA. Теперь вы «подключили» события выхода ко всем элементам управления и работаете с TextBox-выходом: (этот код не запускается при вставке напрямую в 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
...