Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Button in B1 passen einfügen? VBA

Button in B1 passen einfügen? VBA
14.08.2008 16:34:00
Tom
Hi,
ich will einfach per VBA ein Button der auf eine Makro verlinkt ist, in das aktive Tabellenblatt einsetzt und zwar genau passend in die Zelle B1.
Kann mir da vll. einer den Code dafür sagen mit dem Makrorekorder muss ich das passend ziehen das gefällt mir nicht so.
mfg Tom

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Button in B1 passen einfügen? VBA
14.08.2008 19:25:38
Ramses
Hallo
Probier mal
Public Const protName As String = "Protokoll"
Public protWks As Worksheet


Sub AddTest()
    'Aufruf wo der/die Button hin soll/en
    AddButton Range("E5:E10")
End Sub

Sub DelTest()
    'Löscht Buttons in diesem Bereich
    DelButtonProcedure Range("E4:E6")
End Sub

Sub AddButton(tarRange As Range)
    Dim myC As Range
    Set protWks = Worksheets(protName)
    For Each myC In tarRange
        ActiveSheet.Buttons.Add(0, 0, 0, 0).Select
        With Selection
            'Eintragung der Bezugszelle
            protWks.Cells(protWks.Cells(Rows.count, 1).End(xlUp).Row + 1, 1) = myC.Address
            'Eintragung der ButtonBezeichnung
            protWks.Cells(protWks.Cells(Rows.count, 1).End(xlUp).Row, 2) = .name
            Debug.Print .name
            .Top = myC.Top
            .Left = myC.Left
            .Height = myC.Height
            .Width = myC.Width
            .Text = ActiveSheet.Shapes.count
            'Diese Procedure wird ausgelöst
            .OnAction = "TestProcedure"
        End With
    Next
End Sub

Sub DelButtonProcedure(delRange As Range)
    Set protWks = Worksheets(protName)
    Dim tmpName As String
    Dim myC As Range
    Dim i As Integer
    With protWks
        For Each myC In delRange
            For i = .Cells(Rows.count, 1).End(xlUp).Row To 1 Step -1
                If .Cells(i, 1) = myC.Address Then
                    tmpName = .Cells(i, 2).Text
                    ActiveSheet.Shapes(tmpName).Delete
                    .Rows(i).Delete
                    Exit For
                End If
            Next i
        Next
    End With
End Sub

Gruss Rainer
Anzeige

308 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige