动态添加控件和代码

chijanzen

以下是引用lj1226189在2004-7-7 16:25:00的发言：

不知为什么还是打不开！

谢！

你好:

請檢查兩個地方

1.信任VB專案(兩個都打勾)

2.需要引用 FM20.DLL

chijanzen

           Chijanzen - VBA程式碼範例 
索     引 　B0006
主     題 　動態新增UserForm及OptionButton控件
版     本 　>= 8.0(Office 97)
說     明 　本範例示範如何動態建立UserForm及OptionButton控件
參     考
    

Sub GetOption()
    Dim TempForm    'As VBComponent
    Dim NewOptionButton As MSForms.OptionButton
    Dim LeftPos As Integer
    Dim X As Integer, i As Integer, TopPos As Integer
    '   隱藏VBE視窗預防螢幕更新
    Application.VBE.MainWindow.Visible = False
    '   動態新增UserForm
    Set TempForm = ActiveWorkbook.VBProject.VBComponents.Add(3)
    '   新增 OptionButtons
    LeftPos = 4
    k = 1
    TopPos = 5
    For i = 1 To 3
        LeftPos = 4
        For j = 1 To 10
            '動態新增OptionButton控件
            Set NewOptionButton = _
            TempForm.Designer.Controls.Add("forms.OptionButton.1")
            With NewOptionButton
                .Width = 60
                .Caption = k & "℃"
                .Height = 15
                .Left = LeftPos
                .Top = TopPos
                .Tag = k & "℃"
                .AutoSize = True
            End With
            LeftPos = LeftPos + 30
            k = k + 1
        Next j
        TopPos = i * 20 + 5
    Next i
    '寫入Click 事件
    For i = 1 To 30
        With TempForm.CodeModule
            X = .CountOfLines
            .InsertLines X + 1, "Private Sub OptionButton" & i & "_Click()"
            .InsertLines X + 2, "  Cells(8, 8) = Me.ActiveControl.Tag"
            .InsertLines X + 3, "End Sub"
        End With
    Next i
    With TempForm
        .Properties("Caption") = "溫度選項"
        .Properties("Width") = LeftPos + 20
        .Properties("Height") = TopPos + 20
        .Properties("Left") = 160
        .Properties("Top") = 150
    End With
    '顯示窗體
    VBA.UserForms.Add(TempForm.Name).Show
    '關閉後一櫥窗體
    ActiveWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm
End Sub

 

Sub GetOption()
    Dim TempForm    'As VBComponent
    Dim NewOptionButton As MSForms.OptionButton
    Dim LeftPos As Integer
    Dim X As Integer, i As Integer, TopPos As Integer
    '   隱藏VBE視窗預防螢幕更新
    Application.VBE.MainWindow.Visible = False
    '   動態新增UserForm
    Set TempForm = ActiveWorkbook.VBProject.VBComponents.Add(3)
    '   新增 OptionButtons
    LeftPos = 4
    k = 1
    TopPos = 5
    For i = 1 To 3
        LeftPos = 4
        For j = 1 To 10
            '動態新增OptionButton控件
            Set NewOptionButton = _
            TempForm.Designer.Controls.Add("forms.OptionButton.1")
            With NewOptionButton
                .Width = 60
                .Caption = k & "℃"
                .Height = 15
                .Left = LeftPos
                .Top = TopPos
                .Tag = k & "℃"
                .AutoSize = True
            End With
            LeftPos = LeftPos + 30
            k = k + 1
        Next j
        TopPos = i * 20 + 5
    Next i
    '寫入Click 事件
    For i = 1 To 30
        With TempForm.CodeModule
            X = .CountOfLines
            .InsertLines X + 1, "Private Sub OptionButton" & i & "_Click()"
            .InsertLines X + 2, "  Cells(8, 8) = Me.ActiveControl.Tag"
            .InsertLines X + 3, "End Sub"
        End With
    Next i
    With TempForm
        .Properties("Caption") = "溫度選項"
        .Properties("Width") = LeftPos + 20
        .Properties("Height") = TopPos + 20
        .Properties("Left") = 160
        .Properties("Top") = 150
    End With
    '顯示窗體
    VBA.UserForms.Add(TempForm.Name).Show
    '關閉後一櫥窗體
    ActiveWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm
End Sub
說明:   
 vbext_ct_StdModule 成員如下:
 
常數 值 說明
vbext_ct_ClassModule
 2
 將一物件類別模組加到集合物件。
 
Vbext_ct_MSForm
 3
 將表單加到集合物件。
 
vbext_ct_StdModule
 1
 將一般模組加到集合物件。
 
vbext_ct_Document
 100
 將文件模組到集合物件。

--------------------------------------------

因编辑精华贴主题,去掉了一些格式

[此贴子已经被清风_ll于2006-8-28 13:29:08编辑过]

chijanzen

ldhyob 版主的方法是最實用的

看到這個問題讓我想到以下方法,簡單的修改一下或許也不錯

將程式碼複製到Module中,然後執行 GetOption程序

Sub GetOption()

Dim TempForm 'As VBComponent

Dim NewOptionButton As MSForms.OptionButton

Dim LeftPos As Integer

Dim X As Integer, i As Integer, TopPos As Integer

' 隱藏VBE視窗預防螢幕更新

Application.VBE.MainWindow.Visible = False

' 動態新增UserForm

Set TempForm = ActiveWorkbook.VBProject.VBComponents.Add(3)

' 新增 OptionButtons

LeftPos = 4

k = 1

TopPos = 5

For i = 1 To 3

LeftPos = 4

For j = 1 To 10

'動態新增OptionButton控件

Set NewOptionButton = _

TempForm.Designer.Controls.Add("forms.OptionButton.1")

With NewOptionButton

.Width = 60

.Caption = k & "℃"

.Height = 15

.Left = LeftPos

.Top = TopPos

.Tag = k & "℃"

.AutoSize = True

End With

LeftPos = LeftPos + 30

k = k + 1

Next j

TopPos = i * 20 + 5

Next i

'寫入Click 事件

For i = 1 To 30

With TempForm.CodeModule

X = .CountOfLines

.InsertLines X + 1, "Private Sub OptionButton" & i & "_Click()"

.InsertLines X + 2, " Cells(8, 8) = Me.ActiveControl.Tag"

.InsertLines X + 3, "End Sub"

End With

Next i

With TempForm

.Properties("Caption") = "溫度選項"

.Properties("Width") = LeftPos + 20

.Properties("Height") = TopPos + 20

.Properties("Left") = 160

.Properties("Top") = 150

End With

'顯示窗體

VBA.UserForms.Add(TempForm.Name).Show

'關閉後一櫥窗體

ActiveWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm

End Sub

ldhyob

没必要用窗体来做，倒不如用“数据有效性”来得省事快捷。 w3X8SPw4.rar (6.4 KB, 下载次数: 348)

2004-7-6 17:44 上传

点击文件名下载附件
有没有这样的一个窗体！

bchou

路过，收集

song_27149

太强了！！！！！！！

lb_bn

有示范作用的帖子。

yiyiyicz

高人，学习

liucqa

动态窗体控件.rar (15.66 KB, 下载次数: 226)

2013-10-1 12:30 上传

点击文件名下载附件

天蝎牛

留个位子以备自查，好贴就是踩