將代碼分配給動態創建的按鈕

Question

我試圖讓我在excel用戶窗體表單上動態創建一個按鈕，以運行名爲transfer的宏，這是我在項目的「模塊」部分的Module 1中編寫的。

下面我貼我在這實際上設法建立在框架中Transfer to Sheet按鈕（這我還動態創建的）用戶窗體迄今爲止編寫的代碼，但由於某些原因，當我運行VBA我得到一個438 error消息說，Object doesn't support this property or method。

有人可以告訴我如何解決這個問題嗎？

下面的代碼：

Dim framecontrol1 As Control 

Set workitemframe = Controls.Add("Forms.Frame.1") 
With workitemframe 
    .Width = 400 
    .Height = 400 
    .Top = 160 
    .Left = 2 
    .ZOrder (1) 
    .Visible = True 
End With 

workitemframe.Caption = "Test" 
Set framecontrol1 = workitemframe.Controls.Add("Forms.commandbutton.1") 

With framecontrol1 
    .Width = 100 
    .Top = 70 
    .Left = 10 
    .ZOrder (1) 
    .Visible = True 
    .Caption = "Transfer to Sheet" 
End With 
framecontrol1.OnAction = "transfer" 

Answer 1

下面是一個例子。請修改它以滿足您的需求:)

本示例將創建一個命令按鈕併爲其分配代碼，以便當它被按下時，它將顯示「Hello World」。

將此代碼粘貼到命令按鈕的單擊事件中，該按鈕將動態創建一個新的命令按鈕併爲其分配代碼。

Option Explicit 

Dim cmdArray() As New Class1 

Private Sub CommandButton1_Click() 
    Dim ctl_Command As Control 
    Dim i As Long 

    i = 1 

    Set ctl_Command = Me.Controls.Add("Forms.CommandButton.1", "CmdXYZ" & i, False) 

    With ctl_Command 
     .Left = 100 
     .Top = 100 
     .Width = 255 
     .Caption = "Click Me " & CStr(i) 
     .Visible = True 
    End With 

    ReDim Preserve cmdArray(1 To i) 
    Set cmdArray(i).CmdEvents = ctl_Command 

    Set ctl_Command = Nothing 

End Sub 

，並在類模塊

Option Explicit 

Public WithEvents CmdEvents As MSForms.CommandButton 

Private Sub CmdEvents_Click() 

    MsgBox "Hello Word" 

End Sub 

快照

Answer 2

您需要的編程代碼添加到用戶窗體粘貼此代碼。我用代碼從該vbax article作爲參考

下面的代碼：從正常模塊

1. 奔跑將按鈕添加到用戶窗體稱爲UserForm1

2. 添加此代碼到點擊事件的用戶表單

   Private Sub CommandButton1_Click() 
   Call Transfer 
   End Sub 
   

從正常模組的

Sub AddToForm() 
    Dim UF As Object 
    Dim frameCOntrol1 As Object 
    Set UF = ActiveWorkbook.VBProject.VBComponents("UserForm1") 
    Set frameCOntrol1 = UF.designer.Controls.Add("Forms.CommandButton.1") 
    With frameCOntrol1 
     .Width = 100 
     .Top = 70 
     .Left = 10 
     .ZOrder (1) 
     .Visible = True 
     .Caption = "Transfer to Sheet" 
    End With 

    With UF.CodeModule 
     .InsertLines 2, _ 
        "Private Sub " & frameCOntrol1.Name & "_Click()" & Chr(13) & _ 
        "Call Transfer" & Chr(13) & _ 
        "End Sub" 
    End With 

End Sub