1

助けていただければ幸いです。私はネット全体を検索してきましたが、立ち往生しています！

私はしばらくの間 VBA をプログラミングしてきましたが、まだこの言語を理解するのに苦労しています!

MS Project 2007 VBA で VBA UserForm を作成したいと考えています。いくつかのデータは動的であるため、実行時にいくつかのテキスト フィールドを追加する必要があります。

これらを追加するためにいくつかのコードをまとめましたが、非常にうまく機能します。

私の問題は、これらのテキスト フィールドにイベントを追加することです。

私の例は txtPath テキスト フィールドです。私はこのコードでそれを作成します:

  Set NewTextBox = Me.InfoMultiPage(page).Controls.Add("Forms.textbox.1")
  With NewTextBox
      .name = "txtPath"
      .value = "Test"
      .top = m2w_style("top") + (m2w_style("height") * 1)
      .Left = m2w_style("left") + m2w_style("lblWidth") + m2w_style("margin")
      .Width = m2w_style("txtWidth")
      .height = m2w_style("height")
      .font.Size = m2w_style("fontsize")
      .font.name = m2w_style("font")
  End With

そして、txtPath の値が変更された場合の反応が必要です。ここにコード：

Private Sub txtPath_Change() ' イベントは発生しません readProjectsFromConfig (Me.value) End Sub

私がブラウジングして検索したすべての Web サイトは、この方法で動作することを示していますが、イベントは発生しません。

動的に作成されたテキスト フィールドは、手動で作成されたテキスト ボックスのように、「ローカル ウィンドウ」のツリーの同じ場所に表示されないことがわかりました。

それで、少なくともテキストフィールドの値を取得するためにこれを試してみましたが、うまくいきました。

Private Sub btnPath_Click()
  'txtPath.value = "Hello World!" ' Doesn't work. Dynamicly created text field seems not to exist but is visible in UserForm
  'Controls.Item("txtPath").value = "Hello World!" ' This works!
  Controls.Item("txtPath").value = GetDirectory("Pick the folder") ' Pick a folder and write it in the text field txtPath
End Sub

テスト用の完全なコードは次のとおりです。

' Reference to Library
' Microsoft XML, v5.0 need to be activated.
' Go to menu: Tools->References
' Select Microsoft Scripting Runtime

Public m2w_config As Dictionary
Public m2w_style As Dictionary


Sub m2wVariables()
  ' Set global Variables for configuration in a kind of hash.
  Set m2w_config = New Dictionary
  Set m2w_style = New Dictionary

  'Styles for teh UserForm
  m2w_style("font") = "Arial"
  m2w_style("fontsize") = 10
  m2w_style("top") = 6
  m2w_style("left") = 6
  m2w_style("height") = 20
  m2w_style("btnHeight") = 8
  m2w_style("width") = 40
  m2w_style("lblWidth") = 40
  m2w_style("h1Width") = 400
  m2w_style("txtWidth") = 180
  m2w_style("btnWidth") = 72
  m2w_style("margin") = 6

  m2w_config("XMLDateFormat") = "YYYY-MM-DD"
  m2w_config("XMLConfigFileName") = "config.xml" ' should not be changeable
  m2w_config("AppPath") = ""
  m2w_config("Headline") = "" ' Headline in Website
  m2w_config("UpdateHref") = ""
  m2w_config("SubFolder") = "" ' Is it used?
  m2w_config("default_subfolder") = "" ' Is it used?

End Sub

  Private Sub UserForm_Activate()

      Dim LabelArr As Variant
      Dim ProbNameArr As Variant
      Dim TempForm As Object
      Dim NewButton As MSForms.CommandButton
      Dim NewLabel As MSForms.Label
      Dim NewTextBox As MSForms.TextBox
      Dim e As Variant
      Dim x As Integer
      Dim page As String
      'Dim Line As Integer
      'Dim MyScript(4) As String

      m2wVariables


      ' Setup userform
      '~~~~~~~~~~~~~~~~

        'This is to stop screen flashing while creating form
        Application.VBE.MainWindow.Visible = False

        ' Setup tab Website
        '===================
          page = "Website"
          Set NewLabel = Me.InfoMultiPage(page).Controls.Add("Forms.label.1")
          With NewLabel
              .name = "lblHeadlinePath"
              .Caption = "This is the local path where the website shall be stored."
              .top = m2w_style("top") + (m2w_style("height") * 0)
              .Left = m2w_style("left")
              .Width = m2w_style("h1Width")
              .height = m2w_style("height")
              .font.Size = m2w_style("fontsize")
              .font.name = m2w_style("font")
          End With

          Set NewLabel = Me.InfoMultiPage(page).Controls.Add("Forms.label.1")
          With NewLabel
              .name = "lblPath"
              .Caption = "Path:"
              .top = m2w_style("top") + (m2w_style("height") * 1)
              .Left = m2w_style("left")
              .Width = m2w_style("lblWidth")
              .height = m2w_style("height")
              .font.Size = m2w_style("fontsize")
              .font.name = m2w_style("font")
          End With

          Set NewTextBox = Me.InfoMultiPage(page).Controls.Add("Forms.textbox.1")
          With NewTextBox
              .name = "txtPath"
              .value = "Test"
              .top = m2w_style("top") + (m2w_style("height") * 1)
              .Left = m2w_style("left") + m2w_style("lblWidth") + m2w_style("margin")
              .Width = m2w_style("txtWidth")
              .height = m2w_style("height")
              .font.Size = m2w_style("fontsize")
              .font.name = m2w_style("font")
          End With

          'Add event onClick
          ' This is completely weird, it actualy writes code.
          ' My intention is to add an event at runtime.
          With ThisProject.VBProject.VBComponents("msp2web_SettingsForm").CodeModule
            .insertlines .CountOfLines + 1, "Sub txtPath_Change()" & vbCrLf & "MsgBox Me.txtPath.Value" & vbCrLf & "End Sub"
            Debug.Print Now & " This macro has code lines " & .CountOfLines
          End With


          Dim btnName As String
          btnName = "btnPath"
          'Set NewButton = Me.InfoMultiPage(page).Controls.Add("Forms.commandbutton.1", btnName) ' Add dynamicly - but I'm too stupid to add an event action to an dynamicly created button...
          Set NewButton = Me.InfoMultiPage(page).Controls.Item(btnName)
          With NewButton
              .Caption = "Browse..."
              .top = m2w_style("top") + (m2w_style("height") * 1)
              .Left = m2w_style("left") + m2w_style("lblWidth") + m2w_style("margin") + m2w_style("txtWidth") + m2w_style("margin")
              .Width = m2w_style("lblWidth")
              .height = m2w_style("btnHeight")
              .font.Size = m2w_style("fontsize")
              .font.name = m2w_style("font")
              .AutoSize = True
          End With


        ' Setup Tab Project
        '===================
        page = "Project"
        LabelArr = Array("Hallo", "Welt", "Model Year")
        ProbNameArr = Array("Hallo", "Welt", "Model Year")

        'Create 10 Labels just for testing - works fine
        'For x = 0 To 9
        x = 0
        For Each e In LabelArr
            Set NewLabel = Me.InfoMultiPage(page).Controls.Add("Forms.label.1")
            With NewLabel
              .name = "FieldLabel" & x + 1
              .Caption = e
              .top = m2w_style("top") + (m2w_style("height") * x)
              .Left = m2w_style("left")
              .Width = m2w_style("lblWidth")
              .height = m2w_style("height")
              .font.Size = m2w_style("fontsize")
              .font.name = m2w_style("font")
            End With
            x = x + 1
        Next

        'Create 10 Text Boxes
        'For x = 0 To 9
        x = 0
        For Each e In ProbNameArr
            Set NewTextBox = Me.InfoMultiPage(page).Controls.Add("Forms.textbox.1")
            With NewTextBox
              .name = "MyTextBox" & x + 1
              .top = m2w_style("top") + (m2w_style("height") * x)
              .Left = m2w_style("left") + m2w_style("lblWidth") + m2w_style("margin")
              .Width = m2w_style("lblWidth")
              .height = m2w_style("height")
              .font.Size = m2w_style("fontsize")
              .font.name = m2w_style("font")
            End With
            x = x + 1
        Next

    End Sub

    Private Sub btnPath_Click()
      'txtPath.value = "Hello World!" ' Doesn't work. Dynamicly created text field seems not to exist but is visible in UserForm
      'Controls.Item("txtPath").value = "Hello World!" ' This works!
      Controls.Item("txtPath").value = GetDirectory("Pick the folder") ' Pick a folder and write it in the text field txtPath
    End Sub

    Private Sub txtPath_Change() ' Event doesn't shoot
      readProjectsFromConfig (Me.value)
    End Sub


    Private Sub Refresh_Click()
      readProjectsFromConfig (Controls.Item("txtPath").value)
    End Sub

コード ベースの (実行時に) テキスト ボックスとコマンド ボタンを作成し、それらにイベントを追加する方法を教えてください。

4

2 に答える 2

2

SOに関する同様の質問に対するGaryの回答を参照してください。クラスを使用して WithEvents を宣言することで実行できます。

共有イベント ハンドラーのみを取得しますが、呼び出し元のコントロールに基づいてアクションを切り替えることができます。

ティム

于 2011-03-31T00:03:16.177 に答える
1

ユーザーフォームにコントロールを動的に追加したい場合は、ここにあるものと同様に、作成した withevents クラスにコントロールを追加するルートに進みます。

于 2011-03-31T00:04:09.617 に答える