简体   繁体   中英

VBA create a dynamic button in excel

I need some help with following code.

  1. Its first purpose is to check if the button exist (Works fine).

  2. Create a dynamic button on the spreadsheet("Top20LossContracts"), (this works too)

  3. Finally, when the button is pressed it runs another Sub method called "FilterPivotTable"

Point 3 above has a compile error in "Sub Modify_CommButton" and will not create the desired code Module. I don't know how to proceed.

Loads of errors such as "Method or data member not found" even though I tired to declare all data types.

Running code on Excel 2013 Many thanks in advance.

    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

The VBProject is the property of the Workbook object, not the Worksheet object. Also, you'll need to use the sheet's code name, not sheet name, when referring to a component within the VBComponents collection.

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

Also, the string that you've built for your procedure isn't quite right. And, instead of assigning characters, such as a tab or carriage return, to a variables, you can use VBA constants. I think your procedure could be rewritten as follows...

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM