Hsieh

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

我已經手動將表單移除，仍然是如此 ~~ 所以我 不知該如何作 ~~

Hsieh

回復 12# C.F


   手動移除表單後，因記憶體仍未釋放此表單
請連同Thisworkbook模組內的所有程式碼刪除後存檔
即可執行Auto_Open程序

C.F

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

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

我用 MyForm.Designer.Controls("MyList2") 不能成功 ~~

C.F

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

不好意思，後來試了 Unload Test_Form3 就可以關了  ~~
可是我要如何 返回原來的 Sub Auto_Open() 時，我如何取得 Item_GetList 裏的那些項目啊？

wanmas

回復 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

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

modelcrazyer

我的問題比較簡單一點，程式的目的是在既有的表單(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.
請問問題出在哪??