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