如何在VBA中以编程方式添加activeX按钮，填充列中的所有行

我在这里的第一篇文章，但已经成功地从这个网站上寻找解决方案和想法一段时间了。因此，感谢您收集解决方案和想法

基本上，我有一个电子表格应用程序，要求第一列a列在每个单元格中填充“活动X”按钮，循环给定数量。我在下面发布了一个这样的工作解决方案，它使用了“表单类型按钮”和一个模块。这说明了我认为我最喜欢的例子是工作按钮。一旦操作，按钮列将对应于同一行上的相关数据，单击按钮将在以后的开发中打开相应的文件夹和用户表单

第二篇文章使用了Range函数，但显然没有包含任何可以交互的按钮。但是，在该范围内单击鼠标显然会激活工作表\u选择更改过程中的任何代码…抱歉，仅说明显而易见的问题

我一直试图实现的是一个使用“activeX”命令按钮的代码版本，但在学习了一些优秀的教程和大量的编程概念之后，我仍然无法使用OLEObjects

表1程序： 子栏a_按钮（）

"

表单按钮模块：

Sub Line_Buttons()

 Click_Button = Application.Caller

    MsgBox Click_Button & " was Clicked"

        UserForm1.Show 'Launch custom userform

End Sub

下一个要考虑的选择是距离检测

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  ' e.g., range(A1:E1) is clicked
       If Not Application.Intersect(Target, Range("B2:B12")) Is Nothing Then
            MsgBox "You clicked " & Target.Address
       End If
End Sub

---

下面是一个创建ActiveX按钮并将其编码为运行的示例。这可能需要一些小的调整，但会完成工作

Sub CreateButton()            

Dim Obj As Object            
Dim Code As String            
Dim cellLeft As Single
Dim cellTop As Single
Dim cellwidth As Single
Dim cellheight As Single
Dim LineQty as Integer

Sheets("Sheet1").Select  

LineQty = 5

For i = 1 To LineQty
Set rng = ActiveSheet.Range(Cells(i, 1), Cells(i, 1))
    cellLeft = rng.Left
    cellTop = rng.Top
    cellwidth = rng.Width
    cellheight = rng.Height
    'create button            
    Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False, Left:=cellLeft, Top:=cellTop, Width:=cellWidth, Height:=cellHeight)            
    Obj.Name = "TestButton"            
    'button text            
    ActiveSheet.OLEObjects(1).Object.Caption = "Test Button"            

    'macro text to be added possibly by array?           
    Code = "Private Sub TestButton_Click()" & vbCrLf            
    Code = Code & "Call Tester" & vbCrLf            
    Code = Code & "End Sub"            
    'add macro at the end of the sheet module            
    With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule            
        .insertlines 
        .CountOfLines + 1, Code            
    End With 

Next i

End Sub            

Sub Tester()            
    MsgBox "You have clicked on the test button"            
End Sub

---

注意：为了不让我出错，我必须转到“信任中心”和“信任中心设置”和“宏设置”，并选中“信任访问VBA项目对象模型”复选框“确定”。我在这里发布了一些代码，这些代码是我根据这篇文章编写的：。我现在似乎陷入了他们在上一篇文章中描述的同样的停滞状态：

“是的，它是单个复选框。您可以在中模拟控件阵列 VBA，使每个复选框使用相同的单击事件代码，但这是 可能是杀伤力太大了。”

如果我读了上面Jason的帖子，这就是他对事件代码的质疑

在完成这段代码时欢迎任何帮助，因为我还没有看到一个工作示例，根据上面的表单按钮模块将它与单个事件联锁

    Sub Macro1()

Dim objCmdBtn As Object
Dim i As Integer
Dim Rnge As Range

Set ColumnRange = Range("A:A") ' Set width & height of column A
    ColumnRange.ColumnWidth = 5: ColumnRange.RowHeight = 15.75

'Delete previous objCmdBtn
For Each objCmdBtn In ActiveSheet.OLEObjects
    If TypeName(objCmdBtn.Object) = "CommandButton" Then objCmdBtn.Delete
    Next objCmdBtn 'TypeName Function returns the data-type about a variable - TypeName(varname is objCmdBtn)



    With ActiveSheet

        For i = 1 To 25

            Set Rnge = ActiveSheet.Range(Cells(i + 1, 1), Cells(i + 1, 1))
            Set objCmdBtn = Sheets("Sheet1").OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
                                     Link:=False, _
                                     DisplayAsIcon:=False, _
                                     Left:=Rnge.Left, _
                                     Top:=Rnge.Top, _
                                     Width:=Rnge.Width, _
                                     Height:=Rnge.Height)

                                     With objCmdBtn
                                        'set a String value as object's name
                                        '.Name = "CommandButton1"

                                        With .Object
                                             .Caption = i
                                             With .Font
                                                  .Name = "Arial"
                                                  .Bold = True
                                                  .Size = 7
                                                  .Italic = False
                                                  .Underline = False
                                             End With
                                        End With
                                    End With
        Next
    End With

End Sub

    Sub Macro1()

Dim objCmdBtn As Object
Dim i As Integer
Dim Rnge As Range

Set ColumnRange = Range("A:A") ' Set width & height of column A
    ColumnRange.ColumnWidth = 5: ColumnRange.RowHeight = 15.75

'Delete previous objCmdBtn
For Each objCmdBtn In ActiveSheet.OLEObjects
    If TypeName(objCmdBtn.Object) = "CommandButton" Then objCmdBtn.Delete
    Next objCmdBtn 'TypeName Function returns the data-type about a variable - TypeName(varname is objCmdBtn)



    With ActiveSheet

        For i = 1 To 25

            Set Rnge = ActiveSheet.Range(Cells(i + 1, 1), Cells(i + 1, 1))
            Set objCmdBtn = Sheets("Sheet1").OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
                                     Link:=False, _
                                     DisplayAsIcon:=False, _
                                     Left:=Rnge.Left, _
                                     Top:=Rnge.Top, _
                                     Width:=Rnge.Width, _
                                     Height:=Rnge.Height)

                                     With objCmdBtn
                                        'set a String value as object's name
                                        '.Name = "CommandButton1"

                                        With .Object
                                             .Caption = i
                                             With .Font
                                                  .Name = "Arial"
                                                  .Bold = True
                                                  .Size = 7
                                                  .Italic = False
                                                  .Underline = False
                                             End With
                                        End With
                                    End With
        Next
    End With

End Sub