AW: CommandButton mit VBA-Code zuweisen
31.10.2015 01:09:10
fcs
Hallo Hermann,
wenn du eine farbige Schaltfläche möchtest, dann muss du ein Rechteck oder eine andere Form als Basis nehen. Die Schaltflächen aus den Formular-Steuerelementen lassen sich nicht färben.
Ob man das Ganze mit Active-X-Schaltfläche und Klassen-Modul gebacken bekommt: ?
Active-X-Elemente in einem Tabellenblatt erwarten ihre Ereignismakros nun mal im Code-Modul des Tabellenblatts.
Mit dem Löschen des Blattes killst du ja auch das Axtive-X-Element mit seinem Makro. Das kommt bei Excel auch nicht so gut an - Makro-Ausführung wird normalerweise abgerochen.
Gruß
Franz
Kann dann wie folgt aussehen:
Sub Inhaltsverzeichnis()
Application.DisplayAlerts = False
Sheets("Inhaltsverzeichnis").Delete
Application.DisplayAlerts = True
Worksheets.Add before:=ActiveWorkbook.Sheets(1)
With ActiveSheet
.Name = "Inhaltsverzeichnis"
'Rechteck als Schaltfläche einfügen
Call fncRechteck_Bunt("Aktualisieren", _
.Range("B2").Left, .Range("B2").Top, 120, 30, _
strOnAction:="Inhaltsverzeichnis", _
lngFillForeColorRGB:=RGB(255, 255, 0), _
strFontName:="Verdana", intFontSize:=14)
End With
End Sub
Function fncRechteck_Bunt(ByVal strCaption As String, _
ByVal dblLeft As Double, ByVal dblTop As Double, _
ByVal dblWidth As Double, ByVal dblHeight As Double, _
Optional ByVal strOnAction As String, _
Optional ByVal lngFillForeColorRGB As Long = 14277081, _
Optional ByVal strFontName As String = "Arial", _
Optional ByVal intFontSize As Integer = 12, _
Optional wks As Worksheet) As Object
' lngFillForeColorRGB: 14277081 = hellgrau (RGB(217, 217, 217)
' Rechteck mit Doppelline als Rahmen, schwarzer Schrift (msoShapeStylePreset1)
Dim objShape As Object
If wks Is Nothing Then Set wks = ActiveSheet
'Form einfügen
Set objShape = wks.Shapes.AddShape(msoShapeRectangle, dblLeft, dblTop, _
dblWidth, dblHeight)
Set fncRechteck_Bunt = objShape
With objShape
.ShapeStyle = msoShapeStylePreset1 'Weiß mit schwarzem Rahmen, schwarzer Shrift
With .TextFrame2 'Textfeld
.VerticalAnchor = msoAnchorMiddle
With .TextRange
.ParagraphFormat.Alignment = msoAlignCenter
With .Font
.NameComplexScript = strFontName
.NameFarEast = strFontName
.Name = strFontName
.Size = intFontSize
.Strikethrough = False
.Superscript = False
.Subscript = False
End With
.Characters.Text = strCaption 'muss nach den Formatierungen eingefügt werden!
End With
End With
With .Fill 'Füllfarbe
.Visible = msoTrue
.ForeColor.RGB = lngFillForeColorRGB
.Transparency = 0
.Solid
End With
With .Line 'Rahmen
.Visible = msoTrue
.Weight = 2.25
.Style = msoLineThinThin
End With
.Shadow.Type = msoShadow21 'Schatten rechts-unten
If strOnAction "" Then
.OnAction = strOnAction
End If
End With
End Function