Excel VBA-动态添加ActiveX对象的GotFocus / LostFocus事件处理程序

时间:2018-09-20 10:09:44

标签: excel-vba dynamic event-handling activexobject

我使用Excel创建了一个工具来收集用户的输入,并使用它来进行数据处理。我在带有一堆ActiveX控件(文本框,列表框,组合框)的工作表上创建了一个UI。 ActiveX控件的一部分是动态的-它们在运行时根据工具管理员在第二个工作表上创建的“元数据”添加。元数据包含字段名称,ActiveX控件的类型,控件的位置,用于填充值的ListRange,多文本/多选择标志等。

我能够将ActiveX控件成功添加到UI工作表中。但是,现在我想为ActiveX TextBox控件添加功能,以在控件获得焦点时显示默认文本-删除默认文本,在控件失去焦点时显示-如果用户输入了任何数据,则它将保留,否则默认文本将再次显示

 Public Sub df_segment_GotFocus()
   Dim wb As Workbook
   Set wb = ThisWorkbook
   Set form_sheet = Worksheets(Sheet1.Name)

   If form_sheet.OLEObjects("df_segment") Is Nothing Then

   Else
    'When user begins to type, remove the help text and remove Italics
    Dim seg_val As String
    seg_val = form_sheet.OLEObjects("df_segment").Object.Value
    If seg_val = "e.g. Desktop-Mac,Desktop-Win,Mobile-OSX" Then
          form_sheet.OLEObjects("df_segment").Object.Font.Italic = False
          form_sheet.OLEObjects("df_segment").Object.Value = ""
    Else
          form_sheet.OLEObjects("df_segment").Object.Value = seg_val
    End If
   End If
End Sub

Public Sub df_segment_LostFocus()
   Dim wb As Workbook
   Set wb = ThisWorkbook
   Set form_sheet = Worksheets(Sheet1.Name)

   If form_sheet.OLEObjects("df_segment") Is Nothing Then

   Else
    'Incase user doesn't enter any values, show the help text again
    Dim seg_val As String
    seg_val = form_sheet.OLEObjects("df_segment").Object.Value
    If seg_val = "" Then
          form_sheet.OLEObjects("df_segment").Object.Font.Italic = True
          form_sheet.OLEObjects("df_segment").Object.Value = "e.g. Desktop-Mac,Desktop-Win,Mobile-OSX"
    Else
          form_sheet.OLEObjects("df_segment").Object.Value = seg_val
    End If
   End If
End Sub

在上面的示例代码中,您可以看到我使用控件的确切名称来设置GotFocus和LostFocus事件处理程序。但是,由于我的UI是元数据驱动的,因此控件将动态添加/删除,而且我不知道显式添加事件处理程序的控件名称。

我查看了论坛并实施了此操作: a。)实现了一个类模块

Public WithEvents df_TextBox As MSForms.TextBox
Public df_TextBox_Name As String

Private Sub df_TextBox_Change()
     Dim wb As Workbook
     Set wb = ThisWorkbook
     Set form_sheet = Worksheets(Sheet1.Name)
     Set metadata_sheet = Worksheets(Sheet2.Name)

     Dim obj_name As String
     obj_name = df_TextBox_Name
     obj_val = form_sheet.OLEObjects(obj_name).Object.Value

     MsgBox "Change in TextBox" & obj_val

End Sub

b。)为我在其中实例化控件对象的Class创建的对象

  ElseIf d_Type = "TextBox" Then
     df_obj.Object.Value = d_def_val
     df_obj.Object.Font.Italic = True

     If d_Multi = 1 Then
        df_obj.Object.MultiLine = True
     End If

     '--------------------------------------------------------------
     'part where we add the custom events for GotFocus and LostFocus
     '--------------------------------------------------------------
     ReDim Preserve TextBox_Event_Array(1 To i)
     Set TextBox_Event_Array(i).df_TextBox = df_obj.Object
     TextBox_Event_Array(i).df_TextBox_Name = df_obj.Name

问题陈述

1。)创建类模块时,看不到可用的GotFocus和LostFocus事件。仅更改,按下/按下/向上键,按下/移动/向上键

2。)我创建了一个Change事件处理程序,只是为了测试类模块,但我看不到它被触发。

关于如何解决问题或任何替代解决方案的任何建议?

0 个答案:

没有答案