Grafik als CommandBarControl

Hallo, liebe Excel Gemeinde,
ich möchte eine Iconleiste mit selbst definierten Grafiken erstellen. Aktuell verwende ich dazu die folgende Routine:


Sub SymbolleisteMitGrafik()
Dim Symb As CommandBar
Dim Icon As CommandBarControl
On Error Resume Next
Set Symb = Application.CommandBars.Add("Ampel", msoBarFloating)
Set objValueMonitor0 = Symb.Controls.Add(msoControlButton)
Worksheets("Tabelle3").Shapes("Ampel_rot").CopyPicture
objValueMonitor0.PasteFace
objValueMonitor0.TooltipText = "Testtext über" & Chr(10) & "mehrere Zeilen"
Symb.Visible = True
End Sub

Mein Ziel ist es jedoch, das Aussehen des Icons bei bestimmten Aktionen zu verändern, sprich, die Ampel auch einmal auf gelb oder grün stehen zu lassen. Daher möchte ich bei Öffnen der Arbeitsmappe die verwendeten Grafiken bereits als Objekte zur Verfügung stellen und nachher nur noch das neue Aussehen manipulieren.
Mein Ansatz dazu sieht aktuell wie folgt aus:
Dim objTrLightRed, objTrLightYelRed, objTrLightGreen As Shape


Sub GetPictures()
Set objTrLightRed = Worksheets("Tabelle3").Shapes("Ampel_rot")
Set objTrLightYelRed = Worksheets("Tabelle3").Shapes("Ampel_gelb_rot")
Set objTrLightGruen = Worksheets("Tabelle3").Shapes("Ampel_gruen")
End Sub

Wie weise ich dieses Objekt dem CommandBarControl zu ??
Danke und tschüß
Michael

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Michael
Versuch's mal in etwa so ...
Sollte 'Enum' mit xl97 nicht funktionieren, dann einfach normale Konstanten verwenden.

Option Explicit
Enum AMPEL_FARBEN
    AMPEL_ROT = 1
    AMPEL_GELB
    AMPEL_GRUEN
End Enum
Sub SymbolleisteMitGrafik(Status As AMPEL_FARBEN)
    Dim Symb As CommandBar
    Dim Icon As CommandBarControl

    'On Error Resume Next

    Set Symb = Application.CommandBars("Ampel")

    If Symb Is Nothing Then
        Set Symb = Application.CommandBars.Add("Ampel", msoBarFloating)
    End If

    Set Icon = GetControl(Symb, Status)

    Symb.Visible = True

End Sub
Private Function GetControl( _
cb As CommandBar, Status As AMPEL_FARBEN) As CommandBarControl

    Dim ctl As CommandBarControl

    On Error Resume Next

    cb.Controls("Ampel").Delete

    Set ctl = cb.Controls.Add(msoControlButton)
    Select Case Status
    Case AMPEL_ROT
        Worksheets("Tabelle3").Shapes(1).CopyPicture
        ctl.PasteFace
        ctl.TooltipText = "Testtext über" & Chr(10) & "mehrere Zeilen"
    Case AMPEL_GELB
        Worksheets("Tabelle3").Shapes(2).CopyPicture
        ctl.PasteFace
        ctl.TooltipText = "Testtext über" & Chr(10) & "mehrere Zeilen"
    Case AMPEL_GRUEN
        Worksheets("Tabelle3").Shapes(3).CopyPicture
        ctl.PasteFace
        ctl.TooltipText = "Testtext über" & Chr(10) & "mehrere Zeilen"
    End Select

    ctl.Caption = "Ampel"

    Set GetControl = ctl

End Function

Code eingefügt mit Syntaxhighlighter 2.3

Gruß
Thomas
Risi Thomas Softwareentwicklung

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread