Wie ActiveX-Schaltflächen programmgesteuert in VBA hinzugefügt werden, füllen Sie alle Zeilen in einer Spalte

Question

Meine erste Post hier, aber seit einer Weile erfolgreich Lösungen und Ideen von dieser Website Sourcing jetzt. Danke für die Sammlung von Lösungen und Ideen.

Grundsätzlich habe ich eine Tabellenkalkulationsanwendung, bei der die erste Spalte, Spalte A, in jeder Zelle mit "Active X" -Schaltflächen gefüllt werden muss, die für eine bestimmte Menge durchlaufen werden. Ich habe unten eine solche Arbeitslösung gepostet, die "Formulartasten" und ein Modul verwendet. Dies veranschaulicht, was ich als mein bevorzugtes Beispiel mit funktionierenden Tasten betrachte. Sobald sie betriebsbereit ist, entspricht die Spalte der Schaltflächen den relativen Daten in derselben Zeile, und wenn sie angeklickt wird, werden entsprechende Ordner und Benutzerformen in späteren Entwicklungen geöffnet.

Der zweite Post verwendet die Range-Funktion, enthält aber offensichtlich keine Schaltflächen zum Interagieren mit. Ein Mausklick über diesen Bereich wird jedoch offensichtlich jeden Code aus dem Worksheet_Selection Change-Verfahren aktivieren ... Sorry, nur das Offensichtliche anzugeben!

Was ich versucht habe zu erreichen, ist eine Version des Codes mit "activeX" Command Buttons, aber nachdem ich einige großartige Tutorials studiert und eine Reihe von Programmierungskonzepten ausgegossen habe, scheitere ich immer noch kläglich OLEObjects zu verwenden.

How to add a button programmatically in VBA next to some sheet cell data?

Blatt 1 Verfahren: Sub ColumnA_Buttons()

Dim buttons As Button 
    Dim rng As Range 
    Dim LineQty As Variant 

     Application.ScreenUpdating = False 
     ActiveSheet.buttons.Delete 

    LineQty = 5 

    For i = 1 To LineQty 
     Set rng = ActiveSheet.Range(Cells(i, 1), Cells(i, 1)) 
     Set buttons = ActiveSheet.buttons.Add(rng.Left, rng.Top, rng.Width, rng.Height) 

      With buttons 
       .OnAction = "Buttons" 
       .Caption = "Line " & i 
       .Name = "Line " & i 
       End With 
     Next i 

     Application.ScreenUpdating = True 

End Sub 

Public Click_Button As Variant ' Make Variable Public for Userform1 

'

Formular Tastenmodul:

Sub Line_Buttons() 

Click_Button = Application.Caller 

    MsgBox Click_Button & " was Clicked" 

     UserForm1.Show 'Launch custom userform 

End Sub 

Und die nächste Option in Betracht gezogen werden, ist ein Bereichserkennung

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 

Answer 1

Hier ist ein Beispiel für ActiveX-Schaltflächen, die zum Ausführen erstellt und codiert werden. Es kann einige kleine Verbesserungen erfordern, aber die Arbeit wird erledigt.

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 

Hinweis Damit dies auf mich nicht Fehler, musste ich das Trust-Center gehen und in der Mitte Einstellungen und Makro-Einstellungen und markieren Sie das Kästchen „Vertrauen Zugriff auf das VBA-Projektobjektmodell“ zu vertrauen

Answer 2

Ok. Ich poste einen Code, an dem ich gearbeitet habe, basierend auf diesem Beitrag hier: Multiple active X checkboxes.... Es scheint, dass ich jetzt auf den gleichen Stand gekommen bin, noch sie wie in ihrem letzten Beitrag descibed hat.

„Ja, es einzelnes Kontrollkästchen werden Sie können Steuer Arrays in VBA emulieren, so dass jede Checkbox den gleichen Klick verwendet Ereigniscode, aber das ist wahrscheinlich übertrieben IMO. "

Und wenn ich Jasons Beitrag oben lesen, das ist, was er in Frage in Bezug auf den Ereigniscode.

Jede Hilfe bei der Fertigstellung dieses Codes begrüßt, da ich noch kein funktionierendes Beispiel gesehen habe, das es zu einem einzigen Ereignis verriegelt, wie oben im Formular-Button-Modul.

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