VBA在excel中创建一个动态按钮

Question

我需要以下代码方面的帮助。

1. 它的第一个目的是检查按钮是否存在（工作正常）。

2. 在电子表格上创建一个动态按钮（“Top20LossContracts”），（也可以）

3. 最后，当按钮被按下时，它会运行另一个名为“FilterPivotTable”的子方法

上述第 3 点在“Sub Modify_CommButton”中有编译错误，不会创建所需的代码模块。我不知道该怎么做。

即使我厌倦了声明所有数据类型，也会出现大量错误，例如“找不到方法或数据成员”。

在 Excel 2013 上运行代码 非常感谢。

    Option Explicit

    ' Sub works fine
    Sub AddComm_button()
       Dim obj As OLEObject
       Dim FindButton As Boolean
       Dim mybutton
       For Each obj In ActiveSheet.OLEObjects
           If TypeOf obj.Object Is MSForms.CommandButton Then
        If obj.Name = "Filter_profit" Then
            FindButton = True
            Exit For
        End If
      End If
     Next

     If Not FindButton Then
       Set mybutton = ActiveSheet.OLEObjects.Add         (ClassType:="Forms.CommandButton.1")
       Application.DisplayAlerts = False
       With mybutton
       .Name = "Filter_profit"     
       .Object.Caption = "Filter Profit"
       .Top = 20
       .Left = 126
       .Width = 126.75
       .Height = 25.5
       .Placement = xlMoveAndSize
       .PrintObject = True           
        End With

        Call Modify_CommButton
     End If
  End Sub

  Sub Modify_CommButton()
   Dim LineNum As Long 'Line number in module
   Dim SubName As String 'Event to change as text
   Dim Proc As String 'Procedure string
   Dim EndS As String 'End sub string
   Dim Ap As String 'Apostrophe
   Dim Tabs As String 'Tab
   Dim LF As String 'Line feed or carriage return
   Dim ws As Worksheet

   Ap = Chr(34)
   Tabs = Chr(9)
   LF = Chr(13)
   EndS = "End Sub"
   SubName = "Private Sub Filter_profit_Click()" & LF
   Proc = Tabs & "Call " & Ap & "FilterPivotTable(0)" & Ap & LF
   Proc = Proc & "End Sub" & LF
   ws = Sheets("Top20LossContracts")

   Application.DisplayAlerts = False
   Set NewModule = ws.VBProject.VBComponents("Top20LossContracts").CodeModule
   With NewModule
     LineNum = .CountOfLines + 1
    .InsertLines LineNum, SubName & Proc & EndS
   End With
  End Sub

Answer 1

VBProject 是 Workbook 对象的属性，而不是 Worksheet 对象的属性。此外，在引用 VBComponents 集合中的组件时，您需要使用工作表的代码名称，而不是工作表名称。

Set NewModule = ActiveWorkbook.VBProject.VBComponents(ws.CodeName).CodeModule

另外，您为您的程序构建的字符串也不太正确。并且，您可以使用 VBA 常量，而不是将字符（例如制表符或回车符）分配给变量。我认为您的程序可以重写如下...

Sub Modify_CommButton()
    Dim ws As Worksheet
    Dim CM As Object 'Code module
    Dim LineNum As Long 'Line number
    Dim Proc As String 'Procedure

    Set ws = Worksheets("Top20LossContracts")

    Proc = "Private Sub Filter_profit_Click()" & vbCrLf
    Proc = Proc & vbTab & "Call FilterPivotTable(0)" & vbCrLf
    Proc = Proc & "End Sub" & vbCrLf

    Application.DisplayAlerts = False
    Set CM = ActiveWorkbook.VBProject.VBComponents(ws.CodeName).CodeModule
    With CM
      LineNum = .CountOfLines + 1
     .InsertLines LineNum, Proc
    End With
End Sub