Board logo

標題: [發問] 動態新增 UserForm 及 CommandButton 後 如何寫click的動作？ [打印本頁]
作者: C.F    時間: 2013-1-22 16:00     標題: 動態新增 UserForm 及 CommandButton 後 如何寫click的動作？

我以下列程式碼 新增一個 UserForm 、CommandButton 再用一個 Class 來執行 Button Click 的動作，但 似乎 一直無法 照著 Class 內的動作去執行 ~~
我不知是哪個部份出了問題 ~~

   
   Dim MyNewForm As Object
    Dim NewListBox1 As MSForms.ListBox
    Dim NewLabel1 As MSForms.Label
    Dim NewCommandButton1 As MSForms.CommandButton
   
   
    Dim Btn1 As New Class1
    Dim MyAddItemCode$
    Dim UF_Name$
   
'   Create the UserForm
    Set MyNewForm = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
   
    With MyNewForm
         .Properties("Caption") = "Test_Form1"
         .Properties("Width") = 540
         .Properties("Height") = 350
         '.Name = "Test_Form1"
    End With


      Set NewCommandButton1 = MyNewForm.Designer.Controls _
      .Add("forms.CommandButton.1")
      
    With NewCommandButton1
   
        .Name = "Add_ItemBtn"
        .Left = 235
        .Top = 36
        .Height = 22
        .Width = 50
        .Caption = "新增"
        .Font.Name = "標楷體"
        .Font.Size = 12
        
    End With
        
  
    Set Btn1.CmdBtn = NewCommandButton1

      '   Show the form
    VBA.UserForms.Add(UF_Name$).Show 'vbModeless

    'Delete the form
    ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=MyNewForm

    'ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=Test1
    Set MyNewForm = Nothing


Class 的內容


Option Explicit

Public WithEvents CmdBtn As MSForms.CommandButton
Private Sub CmdBtn_Click()
                MsgBox "Test O.K ! "
End Sub
作者: mark15jill    時間: 2013-1-22 16:17

回復 1# C.F


    你要的目的是什麼?
     空白表單 產出 CommandButton?
     然後 點CommandButton 要有什麼動作?
作者: C.F    時間: 2013-1-22 16:24

其實我還有兩個 ListBox，我主要是點了Button 後 要將左邊 ListBox 的文字 帶到右邊去 ~~
上方是我先測試一下，結果就不成功了 ~~
作者: mark15jill    時間: 2013-1-22 16:33

回復 3# C.F


點下去 左邊到右邊 是複製還是單純搬移?
作者: C.F    時間: 2013-1-22 16:41

是要搬移的
作者: Hsieh    時間: 2013-1-23 10:30

  1. Sub Auto_Open()
  2. Dim MyForm As VBComponent
  3. Set MyForm = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
  4. With MyForm
  5.     .Properties("Caption") = "Test_Form"
  6.     .Name = "Test_Form1"
  7.     With .Designer
  8.       With .Controls.Add("Forms.CommandButton.1")
  9.           .Top = 50
  10.           .Left = 100
  11.           .Height = 20
  12.           .Width = 20
  13.           .Caption = ">>"
  14.           .Name = "Move_Data"
  15.       End With
  16.       For i = 1 To 2
  17.       With .Controls.Add("Forms.Listbox.1")
  18.           .Top = 10
  19.           .Left = (i - 1) * 100 + 20
  20.           .Height = 120
  21.           .Width = 80
  22.           .Name = "MyList" & i
  23.       End With
  24.       Next
  25.     End With
  26.     With .CodeModule
  27.       .InsertLines 1, "Private Sub UserForm_Initialize()"
  28.       .InsertLines 2, "MyList1.List=array(1,2,3,4,5,6,7,8,9)"
  29.       .InsertLines 3, "End Sub"
  30.       .InsertLines 4, "Private Sub Move_Data_Click()"
  31.       .InsertLines 5, "x = MyList1.ListIndex"
  32.       .InsertLines 6, "MyList2.AddItem  MyList1.List(x)"
  33.       .InsertLines 7, "MyList1.RemoveItem x"
  34.       .InsertLines 8, "End Sub"
  35.     End With
  36. End With
  37. With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
  38.   .InsertLines 1, "Private Sub Workbook_BeforeClose(Cancel As Boolean)" & Chr(10) & _
  39. "With ThisWorkbook" & Chr(10) & _
  40. ".VBProject.VBComponents.Remove .VBProject.VBComponents(""Test_Form1"")" & Chr(10) & _
  41. "n = .VBProject.VBComponents(""ThisWorkbook"").CodeModule.CountOfLines" & Chr(10) & _
  42. ".VBProject.VBComponents(""ThisWorkbook"").CodeModule.DeleteLines 1, n" & Chr(10) & _
  43. ".Save" & Chr(10) & _
  44. "End With" & Chr(10) & _
  45. "End Sub"
  46. End With
  47. 'OpenForm '開啟檔案自動開啟表單
  48. End Sub
  49. Sub OpenForm()
  50. 'Test_Form1.Show 0 '開啟表單
  51. End Sub
複製代碼
回復 5# C.F


    是這樣的效果嗎?
[attach]14049[/attach]
[attach]14050[/attach]
一般模組
作者: C.F    時間: 2013-1-23 11:07

感謝您 ~~ 這的確是我要的~~~
只是因為我還會加其它功能 ~~ 所以我相將 按鈕的程式碼部份放到 class 中
請問可以怎麼做？
作者: Hsieh    時間: 2013-1-23 21:52

回復 7# C.F
class1模組
  1. Public WithEvents MyBut As MSForms.CommandButton

  3. Private Sub MyBut_Click()
  4. With Test_Form1
  5.   x = .MyList1.ListIndex
  6.   If x = -1 Then Exit Sub
  7.   .MyList2.AddItem .MyList1.List(x)
  8.   .MyList1.RemoveItem x
  9. End With
  10. End Sub
複製代碼
Module1模組
  1. Public obj As New Class1
  2. Sub Auto_Open()
  3. Dim MyForm As VBComponent
  4. Set MyForm = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
  5. With MyForm
  6.     .Properties("Caption") = "Test_Form"
  7.     .Name = "Test_Form1"
  8.     With .Designer
  9.       With .Controls.Add("Forms.CommandButton.1")
  10.           .Top = 50
  11.           .Left = 100
  12.           .Height = 20
  13.           .Width = 20
  14.           .Caption = ">>"
  15.           .Name = "Move_Data"
  16.       End With
  17.       For i = 1 To 2
  18.       With .Controls.Add("Forms.Listbox.1")
  19.           .Top = 10
  20.           .Left = (i - 1) * 100 + 20
  21.           .Height = 120
  22.           .Width = 80
  23.           .Name = "MyList" & i
  24.       End With
  25.       Next
  26.     End With
  27.     With .CodeModule
  28.       .InsertLines 1, "Private Sub UserForm_Initialize()"
  29.       .InsertLines 2, "MyList1.List=array(1,2,3,4,5,6,7,8,9)"
  30.       .InsertLines 3, "Set obj.MyBut = Controls(""Move_Data"")"
  31.       .InsertLines 4, "End Sub"
  32.     End With
  33. End With
  34. With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
  35.   .InsertLines 1, "Private Sub Workbook_BeforeClose(Cancel As Boolean)" & Chr(10) & _
  36. "With ThisWorkbook" & Chr(10) & _
  37. ".VBProject.VBComponents.Remove .VBProject.VBComponents(""Test_Form1"")" & Chr(10) & _
  38. "n = .VBProject.VBComponents(""ThisWorkbook"").CodeModule.CountOfLines" & Chr(10) & _
  39. ".VBProject.VBComponents(""ThisWorkbook"").CodeModule.DeleteLines 1, n" & Chr(10) & _
  40. ".Save" & Chr(10) & _
  41. "End With" & Chr(10) & _
  42. "End Sub"
  43. End With
  44. 'OpenForm '開啟檔案自動開啟表單
  45. End Sub
  46. Sub OpenForm()
  47. 'Test_Form1.Show 0 '開啟表單
  48. End Sub
複製代碼
[attach]14058[/attach]
作者: C.F    時間: 2013-1-24 10:33

非常感謝您的指導 ~~ 但我遇到一個問題，我之前就遇到 了 ~~

執行這行的時候有時會無法執行 ~~ 不知為何 無法會如 此~
.Name = "Test_Form1"
作者: C.F    時間: 2013-1-24 12:02

會出現 error 75 訊息 ~~
作者: Hsieh    時間: 2013-1-24 15:30

  1. Public obj As New Class1
  2. Sub Auto_Open()
  3. Dim MyForm As VBComponent
  4. For Each vbc In ThisWorkbook.VBProject.VBComponents
  5.    If vbc.Type = 3 Then '檢查表單模組
  6.       If vbc.Name = "Test_Form1" Then Exit Sub '有該表單則跳出程序
  7.    End If
  8. Next
  9. Set MyForm = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm) '新增表單模組
  10. With MyForm
  11.     .Properties("Caption") = "Test_Form" '表單標題
  12.     .Name = "Test_Form1" '表單名稱
  13.     With .Designer
  14.       With .Controls.Add("Forms.CommandButton.1") '新增按鈕
  15.           .Top = 50
  16.           .Left = 100
  17.           .Height = 20
  18.           .Width = 20
  19.           .Caption = ">>"
  20.           .Name = "Move_Data"
  21.       End With
  22.       For i = 1 To 2
  23.       With .Controls.Add("Forms.Listbox.1") '清單
  24.           .Top = 10
  25.           .Left = (i - 1) * 100 + 20
  26.           .Height = 120
  27.           .Width = 80
  28.           .Name = "MyList" & i
  29.       End With
  30.       Next
  31.     End With
  32.     With .CodeModule '在表單模組內新增程序
  33.       .InsertLines 1, "Private Sub UserForm_Initialize()"
  34.       .InsertLines 2, "MyList1.List=array(1,2,3,4,5,6,7,8,9)"
  35.       .InsertLines 3, "Set obj.MyBut = Controls(""Move_Data"")" '將按鈕加入物件類別
  36.       .InsertLines 4, "End Sub"
  37.     End With
  38. End With
  39. With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule '寫入關閉檔案程序的程式碼
  40.   .InsertLines 1, "Private Sub Workbook_BeforeClose(Cancel As Boolean)" & Chr(10) & _
  41. "With ThisWorkbook" & Chr(10) & _
  42. ".VBProject.VBComponents.Remove .VBProject.VBComponents(""Test_Form1"")" & Chr(10) & _
  43. "n = .VBProject.VBComponents(""ThisWorkbook"").CodeModule.CountOfLines" & Chr(10) & _
  44. ".VBProject.VBComponents(""ThisWorkbook"").CodeModule.DeleteLines 1, n" & Chr(10) & _
  45. ".Save" & Chr(10) & _
  46. "End With" & Chr(10) & _
  47. "End Sub"
  48. End With
  49. 'OpenForm '開啟檔案自動開啟表單
  50. End Sub
  51. Sub OpenForm()
  52. 'Test_Form1.Show 0 '開啟表單
  53. End Sub
複製代碼
回復 10# C.F


    應該是你的表單已經存在，而你在一次執行該程序，產生名稱衝突
試試看
作者: C.F    時間: 2013-1-24 16:08

我已經手動將表單移除，仍然是如此 ~~ 所以我 不知該如何作 ~~
作者: Hsieh    時間: 2013-1-24 16:20

回復 12# C.F


   手動移除表單後，因記憶體仍未釋放此表單
請連同Thisworkbook模組內的所有程式碼刪除後存檔
即可執行Auto_Open程序
作者: C.F    時間: 2013-1-24 16:45

記憶體啊 ~~~ 應該是如您所說 ~~ 因為 這問題不是每次發生 ~~
但有時是連續發生，有時 是 連續執行也不會發生 ~~

另外就是想請較 ~~ 如果我要取得 MyList2 中所得到的項目，我在Sub Auto_Open() 中
該如何取得？

我用 MyForm.Designer.Controls("MyList2") 不能成功 ~~
作者: C.F    時間: 2013-1-25 14:11

Private Sub MyNewBtn2_Click()
        Dim i%
        Dim Get_Item1
   
        With Test_Form3
               
             MsgBox .Item_GetList.ListCount
            
             If .Item_GetList.ListCount <> 0 Then
                                 ReDim Get_Item1(.Item_GetList.ListCount - 1) As String
                 For i = 0 To .Item_GetList.ListCount - 1
                     Get_Item1(i) = .Item_GetList.List(i)
                     MsgBox Get_Item1(i)
                 Next i
             End If
            
            
        End With
End Sub      
        我新增了一個 Button 取得了 ListBox 的值，但我要如何讓userform 關閉 且讓
         原來的 Sub Auto_Open() 繼續往下跑~？
作者: C.F    時間: 2013-1-25 14:20

不好意思，後來試了 Unload Test_Form3 就可以關了  ~~
可是我要如何 返回原來的 Sub Auto_Open() 時，我如何取得 Item_GetList 裏的那些項目啊？
作者: wanmas    時間: 2013-2-22 16:25

回復 8# Hsieh


    想請問 在新增CommandButton 之後

    這邊是新增Button的按鈕事件嗎？
    With .CodeModule '在表單模組內新增程序
      .InsertLines 1, "Private Sub UserForm_Initialize()"
      .InsertLines 2, "MyList1.List=array(1,2,3,4,5,6,7,8,9)"
      .InsertLines 3, "Set obj.MyBut = Controls(""Move_Data"")" '將按鈕加入物件類別
      .InsertLines 4, "End Sub"
    End With

   那除了這個方法外能用其他的方法去新增按鈕的事件？
作者: Hsieh    時間: 2013-2-22 16:34

回復 17# wanmas
因為此問題是從新增表單開始
此段程序是表單模組的初始化程序
目的在當表單開啟時將表單內物件的設定加入
個人並不建議使用這樣的方法操作表單
VBA事物件導向的程式語言
除非特別目的，否則應先將物件都設置好
並且每個物件所需的程序預先寫好
屆時只需啟動表單即可執行
這樣在程式撰寫中比較容易偵錯與修正
作者: modelcrazyer    時間: 2016-4-5 22:37

我的問題比較簡單一點，程式的目的是在既有的表單(UserForm3)，新增3個TextBox，然後每個TextBox可以執行function(y_m_dinput (A)，變數為A)，程式碼如下:
For X2 = 1 To 3
Set theTextBox = UserForm3("frame1").Controls.Add("Forms.TextBox.1", "TextBox" & TeCount + X2, True)
  With theTextBox
     .Name = "TextBox" & TeCount + X2
     If X2 = 1 Then
     .Left = 210
     ElseIf X2 = 2 Then
     .Left = 384
     Else
      .Left = 492
     End If
     .Width = 60
     .Top = K2 + 18
    myName = "Userform3"
    With ThisWorkbook.VBProject.VBComponents(myName).CodeModule
     '.DeleteLines 1, .countoflines
      Test = .countoflines - 44
     .insertlines Test, "Private Sub TextBox" & TeCount + X2 & "_Change()"
     .insertlines Test + 1, "A =" & TeCount + X2
     .insertlines Test + 2, "y_m_dinput (A)"
     .insertlines Test + 3, "End sub"
    End With
  End With
Next X2
程式的結果可以跑出3個TextBox，也可以寫了出相對應的程序，但是就是無法執行function.
請問問題出在哪??



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)