Zurück zur Homepage

Menüleiste im Tabellenblatt (HTML-Look)

An mich wurde eine Anfrage gestellt, ob es denn möglich wäre, einen Mouse-Over-Look mit Buttons, also Ole-Steuerelementen zu simulieren. Mouse-Over bedeutet in diesem Fall, dass der Button und/oder der Mauszeiger sein Aussehen ändert, wenn er sich darüber befindet.

Das Ergebnis sehen Sie wie folgt:

Menuergebnis

So etwas zu realisieren, hört sich recht einfach an, besonders, weil gemeine Steuerelemente standardmäßig viele verschiedene Ereignisse bereitstellen. Ein für diesen Fall zweckmäßiges Ereignis ist offensichtlich das MouseMove-Ereignis. In solch einer Ereignisprozedur könnte man nun das Aussehen des jeweiligen Buttons anpassen und das der anderen zurücksetzen. Dazu müsste man eigentlich nur für jedes Steuerelement eine eigene Ereignisprozedur schreiben.

Das ist aber leider etwas zu kurz gedacht, denn ist erst einmal ein Button geändert worden und der Mauszeiger verlässt den Bereich des überwachten Buttons, wird kein weiteres Ereignis ausgelöst, in dem man den ursprünglichen Zustand wiederherstellen könnte. Erst das Überfahren eines anderen Steuerelementes löst dann wieder ein anderes Ereignis aus, welches man zum Zurücksetzen einsetzen könnte.

Ein Tabellenblatt verfügt leider auch nicht über ein solches Mouse-Ereignis. Deshalb greife ich in solch einem Fall gerne auf ein Bildsteuerelement zurück, welches ich transparent und ohne Rahmen formatiere. Dieses muss dann über den anderen Elementen zu liegen kommen, damit ein MouseOver funktioniert.

Ein weiteres Problem ist schließlich, zu gewährleisten, dass ein Klick auf das Bildsteuerelement auf die darunterliegenden Steuerelemente durchgereicht wird. Da das nahezu unmöglich ist und wenn, dann nur mit erheblichem Aufwand möglich ist, werte ich das Klick-Ereignis des darüberliegenden Steuerelements aus. Darin ermittele ich den darunterliegenden Button und rufe die Ereignisprozeduren direkt auf. Wenn man das schon machen muss, stellt sich dann natürlich gleich die Frage, ob es überhaupt solche Prozeduren geben muss. Und denkt man noch etwas weiter, stellt sich natürlich wiederum die Frage, ob es noch notwendig ist, überhaupt Steuerelemente mit Eigenschaftsprozeduren zu benutzen.

Konsequenterweise verzichte ich in diesem Beispiel ganz auf darunterliegende Steuerelemente und setze dafür Standardformen ein. Diese verfügen zwar über keinerlei Ereignisprozeduren, haben aber den großen Vorteil, dass sie viel mehr Möglichkeiten bereitstellen, das Aussehen anzupassen. Das fängt schon damit an, dass man bei normalen Steuerelementen noch nicht einmal die Ecken abrunden kann, während es dagegen standardmäßig viele unterschiedliche Formen gibt. Zudem kann man (je nach Excel Version) beispielsweise Spiegelungen benutzen, wie man im obigen Bild erkennen kann.

Auch bei diesem Beispiel gilt, dass man den Code frei benutzen kann. Eine Veröffentlichung des Codes oder Teilen davon, womöglich noch unter anderem Namen, sollte aber unterbleiben.

Excel-Dateien zum Download ca. 250 KB: MouseOver.xlsm oder MouseOver.xls

Das Klassenmodul des Tabellenblatts Create

Folgendermaßen sieht das Tabellenblatt aus, in dem man den Text und das Aussehen der Menüleiste anpassen kann.

CreateMenu

  1. In die Zelle B7 wird der Blattname eingegeben, in den die Menüleiste kopiert werden soll.
  2. Die Zellen B8 und B9 nehmen Namen auf, nach denen später die Shapes in diesem Blatt benannt werden.
  3. Die Zellen B10 und B11 nehmen den Mustertext auf, der anschließend in den beiden Muster-Shapes angezeigt wird.
  4. In die Zelle B12 wird die Anzahl der Menüpunkte eingegeben, die das spätere Menü haben soll.
  5. In der Zelle B13 wird der spätere horizontale Abstand der Menüpunkte, in B14 der spätere Abstand vom linken Rand und in B15 der spätere Abstand vom oberen Rand eingegeben.
  6. In den Zellbereich B19 bis C28 gibt man schließlich die Beschriftung der späteren Buttons ein.

 

Um ein neues Menü anzulegen, geht man prinzipiell folgendermaßen vor:

  1. Erst werden die Zellen B7 bis B15 ausgefüllt, wobei man die Information in B8 bis B11 im Allgemeinen so belassen kann, wie sie sind, die Grundfunktion wird davon nicht beeinflusst. Anschließend gibt man in den Bereich B19 bis maximal C28 die Beschriftungen der zukünftigen Menüpunkte ein. Es brauchen dort nur soviel Zeilen ausgefüllt werden, wie in der Zelle B12 angegeben.
  2. Ein Klick auf die Schaltfläche “Shapes löschen“ löst die entsprechende Ereignisprozedur aus. Darin werden alle Shapes des Blattes mit Ausnahme der Schaltflächen gelöscht.
  3. Anschließend kann man ein eigenes Shape einfügen, die Einfügeposition ist dabei irrelevant. Nach dem Einfügen und vor dem Duplizieren sollte aber die spätere Größe gesetzt werden, da diese Größe später als Vorlage aller anderen Shapes dient.
  4. Ein Klick auf die Schaltfläche “Shape duplizieren …“ löst die entsprechende Ereignisprozedur aus. Darin wird das erste Shape dupliziert, welches keine Schaltfläche oder Bildsteuerelement ist. Alle anderen Shapes des Blattes mit Ausnahme der Schaltflächen und des versteckten Bildsteuerelements werden gelöscht. Anschließend werden die zwei verbleibenden Shapes an eine bestimmte Position gesetzt und erhalten dabei auch eine Beschriftung.
  5. Nun kann man daran gehen, beide Shapes beliebig zu formatieren. Das Linke Shape entspricht später einem inaktiven, das Rechte einem aktiven Menüpunkt.
  6. Ein Klick auf die Schaltfläche “Zieltabelle erzeugen“ löst die entsprechende Ereignisprozedur aus. Im Zielblatt werden anschließend alle Shapes gelöscht, deren Namen mit “Menu_“ beginnen, oder die “ImageOver“ heißen.
    Anschließend werden nacheinander die Beschriftungen der zwei Shapes an den Text der jeweiligen Menüpunkte angepasst, die zwei angepassten Shapes werden in das Zielblatt kopiert und übereinander an die für diesen Menüpunkt festgelegte Position gesetzt.
    Sind schließlich alle Menüpunkte auf dem Zielblatt angelegt, kopiert man das versteckte Bildsteuerelement in das Zielblatt und setzt es über alle Menüpunkte.
  7. Ein Klick auf die Schaltfläche “Code aus Zelle C4 …“ löst die entsprechende Ereignisprozedur aus. In Zelle C4 befindet sich der VBA-Quelltext, welcher in das Klassenmodul des entsprechenden Tabellenblattes kopiert werden muss.
    Dieser Text wird durch den Klick in die Zwischenablage kopiert, vorausgesetzt, ein Verweis auf MsForms ist in der Entwicklungsumgebung gesetzt. Deshalb befindet sich im aktuellen VBA-Projekt eine UserForm, die das sicherstellt, aber ansonsten keine weitere Funktion besitzt.
    Um auf das Klassenmodul zugreifen zu können, klicken sie einfach mit der rechten Maustaste auf den Tabellenreiter des Blattes und wählen aus dem sich öffnenden Kontextmenü den Punkt “Code anzeigen“.
    Nachdem sich der Code im Klassenmodul befindet, müsste sich auch der MouseOver-Effekt einstellen. Als Cursor, der beim Überfahren eines Buttons angezeigt, wird einer aus dem Cursor-Verzeichnis von Windows verwendet. Eventuell muss an dieser Stelle der Name angepasst werden, das Verzeichnis selbst wird automatisch ermittelt.
  8. Um im Zielblatt leichter Formatierungen vornehmen zu können, kann man durch den Klick auf die zwei rechten Schaltflächen alle Shapes ausblenden und anschließend wieder einblenden.

 

Nachfolgend der Code im Tabellenblatt Create.

Option Explicit
Private Sub cmdCreate_Click()
   Dim objShape   As Shape
   Dim objSource  As Shape
   Dim objSource1 As Shape
   Dim objPic     As Shape
   Dim wsTblDest  As Worksheet
   Dim colIDs     As New Collection
   Dim blnExist   As Boolean
   Dim strDest    As String
   Dim lngAbstand As Long
   Dim lngLeft    As Long
   Dim lngTop     As Long
   Dim i          As Long
   Dim k          As Long
   Dim m          As Long
   On Error GoTo Fehlerbehandlung

   Application.EnableEvents = False

   ' Infos aus dem Tabellenblatt auslesen
   lngAbstand = Me.Range("B13")
   lngLeft = Me.Range("B14")
   lngTop = Me.Range("B15")
   strDest = Me.Range("B7")

   ' Objektvariable Shape-Normal anlegen
   Set objSource = Me.Shapes(Me.Range("B8"))
   If objSource Is Nothing Then
      MsgBox "Normal-Shape fehlt"
      GoTo Fehlerbehandlung
   End If

   ' Objektvariable Shape-Highlight anlegen
   Set objSource1 = Me.Shapes(Me.Range("B9"))
   If objSource1 Is Nothing Then
      MsgBox "Highlight-Shape fehlt"
      GoTo Fehlerbehandlung
   End If

   ' Objektvariable Image-Steuerelement anlegen
   Set objPic = Me.Shapes("ImageOver")
   If objPic Is Nothing Then
      MsgBox "MouseOver-Shape fehlt"
      GoTo Fehlerbehandlung
   End If

   ' Objektvariable Zieltabelle anlegen
   Set wsTblDest = Worksheets(strDest)
   If wsTblDest Is Nothing Then
      MsgBox "Zieltabelle fehlt"
      GoTo Fehlerbehandlung
   End If

   With wsTblDest

      ' Zieltabelle aktivieren
      .Activate

      ' Alle Menü-Shapes der Zieltabelle löschen
      For Each objShape In .Shapes
         If (Left(objShape.Name, 5) = "Menu_") Or _
            (objShape.Name = "ImageOver") Then
            objShape.Delete
         End If
      Next

      ' Zeilen ab Zeile 19 durchlaufen
      For i = 19 To (19 + Me.Range("B12") - 1)

         k = k + 1

         ' Beim Shape-Normal Text der akt. Zeile Spalte 2 setzen
         objSource.TextFrame.Characters.Text = Me.Cells(i, 2)
         ' Shape kopieren
         objSource.Copy
         ' Eine Zelle weit außerhalb aktivieren
         wsTblDest.Range("A20000").Activate
         ' Ins Zielblatt an die Zellposition der aktiven Zelle einfügen
         ActiveSheet.Paste
         ' Ein Shape weit außerhalb suchen
         For Each objShape In .Shapes
            If objShape.Top > 50000 Then Exit For
         Next
         With objShape
            ' Eigenschaften des neu hinzugefügten Shapes setzen
            .Name = "Menu_" & k & "_Lo"
            .Left = (k - 1) * lngAbstand + (k - 1) * .Width + lngLeft
            .Top = lngTop
            .Placement = xlFreeFloating
         End With

         ' Beim Shape-Highlight Text der akt. Zeile Spalte 3 setzen
         objSource1.TextFrame.Characters.Text = Me.Cells(i, 3)
         ' Shape kopieren
         objSource1.Copy
         ' Eine Zelle weit außerhalb aktivieren
         wsTblDest.Range("A20000").Activate
         ' Ins Zielblatt an die Zellposition der aktiven Zelle einfügen
         ActiveSheet.Paste
         ' Ein Shape weit außerhalb suchen
         For Each objShape In .Shapes
            If objShape.Top > 50000 Then Exit For
         Next
         With objShape
            ' Eigenschaften des neu hinzugefügten Shapes setzen
            .Name = "Menu_" & k & "_Hi"
            .Left = (k - 1) * lngAbstand + (k - 1) * .Width + lngLeft
            .Top = lngTop
            .Placement = xlFreeFloating
         End With

      Next

      ' Shape Bildsteuerelement kopieren
      objPic.Copy
      ' Eine Zelle weit außerhalb aktivieren
      wsTblDest.Range("A20000").Activate
      ' Ins Zielblatt an die Zellposition der aktiven Zelle einfügen
      ActiveSheet.Paste
      ' Ein Shape weit außerhalb suchen
      For Each objShape In .Shapes
         If objShape.Top > 50000 Then Exit For
      Next
      With objShape
         ' Eigenschaften des neu hinzugefügten Shapes setzen
         .Name = "ImageOver"
         ' Über alle anderen Shapes legen
         .Top = 0
         .Placement = xlFreeFloating
         .Left = 0
         ' 2 mal die Höhe + Abstand von Oben
         .Height = lngTop + objSource.Height * 2
         ' X mal die Shapebreite + X mal der Abstand
         ' + 2 * Abstand von Links
         .Width = k * lngAbstand + k * objSource.Width + 2 * lngLeft
      End With
   End With
Fehlerbehandlung:
   wsTblDest.Range("A1").Activate
   ' Wichtig
   Application.EnableEvents = True
End Sub

Private Sub cmdCopyName_Click()
   Dim objShape   As Shape
   Dim objSource  As Shape
   Dim objDest    As Shape
   Dim lngID      As Long
   Dim i          As Long

   On Error Resume Next

   For Each objShape In Me.Shapes
      ' Alle Shapes durchlaufen
      If objShape.AutoShapeType <> msoShapeMixed Then
         ' Shape ist kein Steuerelement
         If i = 0 Then
            ' Und ist das erste Shape
            i = i + 1
            ' Name des linken Shapes setzten
            objShape.Name = Me.Range("B8")
            ' Position an die Zelle C8
            objShape.Top = Me.Range("C8").Top
            objShape.Left = Me.Range("C8").Left
            ' Objekt merken
            Set objSource = objShape
            ' ID merken
            lngID = objSource.ID
            ' Text setzen
            objShape.Text = Me.Range("B10")
            objShape.Placement = xlFreeFloating
         Else
            ' Überzählige Shapes löschen
            objShape.Delete
         End If
      End If
   Next

   If i = 0 Then MsgBox "Quellshape fehlt!": Exit Sub

   ' Linkes Shape kopieren und einfügen
   objSource.Copy
   Me.Range("G8").Select
   ActiveSheet.Paste

   For Each objShape In Me.Shapes
      If objShape.AutoShapeType <> msoShapeMixed Then
         If objShape.ID <> lngID Then
            ' Hinzugefügtes Shape gefunden
            ' Name und Text setzen
            objShape.Name = Me.Range("B9")
            objShape.Text = Me.Range("B11")
            objShape.Placement = xlFreeFloating
            Exit For
         End If
      End If
   Next

   objSource.Select

End Sub

Private Sub cmdDelete_Click()
   Dim objShape As Object
   ' Alle Shapes außer den Steuerelementen löschen
   For Each objShape In Me.Shapes
      If objShape.AutoShapeType <> msoShapeMixed Then
         objShape.Delete
      End If
   Next
End Sub

Private Sub cmdHideDestination_Click()
   Dim objShape   As Object
   Dim strDest    As String
   On Error Resume Next
   ' Alle Shapes in der Zieltabelle ausblenden
   Application.EnableEvents = False
   strDest = Me.Range("B7")
   For Each objShape In Worksheets(strDest).Shapes
      objShape.Visible = False
   Next
   Application.EnableEvents = True
End Sub

Private Sub cmdShowDestination_Click()
   Dim objShape   As Object
   Dim strDest    As String
   On Error Resume Next
   ' Alle Shapes in der Zieltabelle einblenden
   Application.EnableEvents = False
   strDest = Me.Range("B7")
   For Each objShape In Worksheets(strDest).Shapes
      objShape.Visible = True
   Next
   Application.EnableEvents = True
End Sub

Private Sub cmdCopyClip_Click()
   Dim objData    As MSForms.DataObject
   ' Quelltext aus Zelle C4 in die Zwischenablage kopieren
   On Error Resume Next
   Set objData = New MSForms.DataObject
   objData.SetText Me.Range("C4")
   objData.PutInClipboard
End Sub

   
End Sub

Die Prozedur cmdCreate_Click

Wird die Prozedur cmdCreate_Click aufgerufen, werden zu Beginn die Informationen über Namen und Zielposition aus dem Tabellenblatt ausgelesen. Anschließend legt man Objektvariablen mit Referenzen auf das Zielblatt, das Bildsteuerelement und die beiden Shapes an, welche als Vorlage für einen inaktiven- und aktiven Menüpunkt dienen. Schlägt das fehl, wird die Prozedur verlassen.

Im Zielblatt werden anschließend alle Shapes gelöscht, deren Namen mit “Menu_“ beginnen, oder die “ImageOver“ heißen. Dazu iteriert man in einer For … Each durch die Shapes-Auflistung und löscht die Shapes mit entsprechenden Namen.

Anschließend wird die Beschriftung des linken Shapes auf dem Blatt Create an den Text des jeweiligen inaktiven Menüpunkts angepasst. Mit dem Copy-Befehl wird dieses Shape kopiert und in die Zeile 20000 des Zielblattes mit dem Paste-Befehl eingefügt. Um das zu erreichen, selektiert man einfach eine Zelle in dieser Reihe.

Man könnte nun annehmen, dass das neu hinzugefügte Shape ganz ans Ende der Shapes-Auflistung gesetzt wird und man über den Index mit Hilfe der Count-Eingenschaft auf dieses Element zugreifen kann. Leider funktioniert das nicht mehr zuverlässig, wenn sich bereits andere Shapes auf dem Zielblatt befinden. Deshalb iteriere ich wiederum in einer For … Each durch die Shapes-Auflistung und suche nach einem Shape mit einer .top-Eigenschaft über 50000. Das ist auch der Grund, warum das Shape in die Zeile 20000 eingefügt wurde. Habe ich so eins gefunden, passe ich den Namen an, berechne die Zielposition und verschiebe das Shape dorthin. Hier wird dann die Position- und Größe unabhängig von der Zellgröße- und Position gemacht, indem man die Placement-Eigenschaft anpasst.

Das gleiche wird nun mit dem zweiten Shape auf dem Blatt Create gemacht, welcher anschließend einen aktiven Menüpunkt darstellt. Dieses Shape wird an die gleiche Position wie das inaktive Shape geschoben. Das Ganze wiederholt sich für jeden weiteren Menüpunkt.

Befinden sich schließlich alle Shapes auf dem Zielblatt, benötigt man dort noch ein unsichtbares Bildsteuerelement, bei dem man das MouseMove-Ereignis überwachen kann. Dazu kopiert man das versteckte Bildsteuerelement vom Blatt Create in das Zielblatt, vergibt den Namen "ImageOver" und setzt es über alle Menüpunkte. Es wird so groß gemacht, dass es über die Ränder der Menüpunkte weit herausragt. Auch bei diesem wird die Position- und Größe unabhängig von der Zellgröße- und Position gemacht, indem man die Placement-Eigenschaft anpasst.

Die Prozedur cmdCopyName_Click

Die Prozedur cmdCopyName_Click wird das erste Shape dupliziert, welches keine Schaltfläche oder Bildsteuerelement ist. Dazu iteriert man in einer For … Each durch die Shapes-Auflistung und liest die Typen der Shapes aus. Handelt es sich nicht um den Typ msoShapeMixed, hat man eine Form vor sich, die anderen, also das Bildsteuerelement und die Schaltflächen, sind vom Typ msoShapeMixed.

Auf die erste gefundene Form wird ein Objektverweis gesetzt und dessen ID ausgelesen. Anschließend werden der Name, die Beschriftung und der angezeigte Text dieser Form gesetzt. Es wird dann noch die Position- und Größe unabhängig von der Zellgröße- und Position gemacht, indem man die Placement-Eigenschaft anpasst. Die restlichen Formen werden gelöscht.

Danach kopiert man die zuvor regenerierte Form und fügt sie in das Blatt ein. In einer Schleife sucht man sich die neu hinzugekommene Form aus der Shapes-Auflistung heraus und vergibt einen Namen und legt den angezeigten Text fest. Obwohl es eigentlich unnötig ist, wird dann noch die Position- und Größe unabhängig von der Zellgröße- und Position gemacht, indem man die Placement-Eigenschaft anpasst.

Beide Shapes werden dabei an eine zuvor festgelegte Position verschoben.

Die Prozeduren cmdHideDestination_Click und cmdShowDestination_Click

In einer Schleife iteriert man in diesen Prozeduren durch die Shapes-Auflistung des Blattes, dessen Name aus der Zelle B7 ausgelesen wurde. Für jedes Element der Auflistung wird dann die Visible-Eigenschaft entweder auf True- oder auf False gesetzt.

Die Prozedur cmdCopyClip_Click

Mit Hilfe des DataObjekts, welches Bestandteil von MsForms ist, kopiert man den Inhalt der Zelle C4 in die Zwischenablage. In dieser befindet sich der Quelltext, welcher das Menü zum Leben erweckt. Um zu kopieren muss in der Entwicklungsumgebung ein Verweis auf MsForms gesetzt werden. Deshalb befindet sich im aktuellen VBA-Projekt eine UserForm, die das sicherstellt, aber ansonsten keine weitere Funktion besitzt.

Die Prozedur cmdDelete_Click

In dieser Prozedur werden alle Shapes gelöscht, die keine Schaltflächen oder Bildsteuerelemente sind. Dazu iteriert man in einer For … Each durch die Shapes-Auflistung und liest die Typen der Shapes aus. Handelt es sich nicht um den Typ msoShapeMixed, hat man eine Form vor sich, die anderen, das Bildsteuerelement und die Schaltflächen sind vom Typ msoShapeMixed.

Das Klassenmodul des Zieltabellenblatts

Nachfolgend der Code im Zieltabellenblatt, welcher dafür sorgt, dass sich der gewünschte MouseOver-Effekt einstellt.

Option Explicit

Private Sub ImageOver_MouseMove( _
   ByVal Button As IntegerByVal Shift As Integer, _
   ByVal X As SingleByVal Y As Single)
   Dim objShape      As Shape
   Dim strTemp       As String
   ' Folgende Variablen bleiben zwischen der Aufrufen gültig
   Static x1         As Single
   Static y1         As Single
   Static objCur     As StdPicture
   Static objImage   As Object
   Static strName    As String

   On Error Resume Next

   ' Das Objekt könnte man direkt referenzieren, aber beim Anlegen
   ' neuer Menüs bei bereits vorhandenem Code kann es zu Problemen
   ' kommen, da das Objekt selbst erst später angelegt wird.
   If objImage Is Nothing Then
      Set objImage = Me.Shapes("ImageOver")
   End If
   If objImage Is Nothing Then
      GoTo Ausgang
   End If

   ' Abbrechen, wenn Summe der Differenz der Mauszeigerpositionen
   ' vorher zu jetzt kleiner 10 Punkte sind. Größerer Wert ergibt
   ' bei langsamen Rechnern einen Geschwindigkeitsvorteil zu
   ' Lasten der Empfindlichkeit
   If (Abs(X - x1) + Abs(Y - y1)) < 10 Then Exit Sub

   ' Die aktuelle Mausposition speichern
   x1 = X: y1 = Y

   ' Ereignisse ausschalten
   Application.EnableEvents = False

   ' Steuerelement ermitteln, über dem der Mauszeiger steht
   strTemp = GetNameFromPoint(objImage.Left + X, objImage.Top + Y)

   ' Mauszeiger anpassen
   With objImage.OLEFormat.Object.Object
      If strTemp = "" Then
         ' Defaultzeiger benutzen
         .MousePointer = fmMousePointerDefault
      Else
         ' Vordefinierter Mauszeiger
         ' objShape.MousePointer = fmMousePointerAppStarting

         ' Auskommentieren, wenn kein besonderer Cursor verwendet
         ' werden soll (Folgende 8 Zeilen). 
Ansonsten muss Pfad
         ' zum Mauszeiger existieren
         If objCur Is Nothing Then
            Set objCur = LoadPicture(Environ("windir") & _
               "\Cursors\harrow.cur")
         End If
         If Not (objCur Is NothingThen
            .MousePointer = fmMousePointerCustom
            .MouseIcon = objCur
         End If

      End If
   End With

   ' DefaultButton für dieses Blatt festlegen. Dieser wird
   ' aktiviert, wenn der Mauszeiger außerhalb eines Buttons ist
   If strTemp = "" Then strTemp = "Menu_1_Hi"

   ' Wenn bereits der Button aktiviert ist, verlassen
   If strName = strTemp Then GoTo Ausgang

   ' Den Namen des aktuellen Buttons speichern
   strName = strTemp

   ' Aktuellen Button aktivieren
   strTemp = Left(strTemp, Len(strTemp) - 2)
   Me.Shapes(strTemp & "Hi").Visible = True
   Me.Shapes(strTemp & "Lo").Visible = False

   For Each objShape In Me.Shapes
      ' Alle Shapes durchlaufen
      With objShape
         If .Name <> "ImageOver" Then
            If .Name <> strTemp & "Lo" Then
               ' Nichtaktive Buttons aller Menüpunkte außer dem
               ' aktuellen einblenden
               If Right(.Name, 2) = "Lo" Then objShape.Visible = True
            End If
            If .Name <> strTemp & "Hi" Then
               ' Aktive Buttons aller Menüpunkte außer dem
               ' aktuellen ausblenden
               If Right(.Name, 2) = "Hi" Then objShape.Visible = False
            End If

         End If
      End With
   Next
Ausgang:
   ' Wichtig, damit Ereignisse weiterverarbeitet werden
   Application.EnableEvents = True
End Sub

Private Sub ImageOver_MouseDown( _
   ByVal Button As IntegerByVal Shift As Integer, _
   ByVal X As SingleByVal Y As Single)
   Dim strTemp       As String

   On Error Resume Next

   ' Kurz Aus- und wieder Einblenden, damit das Steuerelement
   ' nicht undurchsichtig erscheint
   ImageOver.Visible = False
   ImageOver.Visible = True

   ' angeklickten Menüpunkt ermitteln
   strTemp = GetNameFromPoint(ImageOver.Left + X, ImageOver.Top + Y)

   ' Aktion ausführen
   Select Case Left(strTemp, Len(strTemp) - 3)
      Case "Menu_1"
         MsgBox "Menu_1"
      Case "Menu_2"
         MsgBox "Menu_2"
      Case "Menu_3"
         MsgBox "Menu_3"
      Case "Menu_4"
         MsgBox "Menu_4"
      Case "Menu_5"
         MsgBox "Menu_5"
      Case "Menu_6"
         MsgBox "Menu_6"
      Case "Menu_7"
         MsgBox "Menu_7"
      Case "Menu_8"
         MsgBox "Menu_8"
      Case "Menu_9"
         MsgBox "Menu_9"
      Case "Menu_10"
         MsgBox "Menu_10"
   End Select
End Sub

Private Function GetNameFromPoint(ByVal X As SingleByVal Y As SingleAs String
   Dim objShape As Shape
   For Each objShape In Me.Shapes
      ' Alle Shapes durchlaufen und nachschauen, ob Mauszeiger
      ' darüber steht
      With objShape
         If .Name <> "ImageOver" Then
            If Left(.Name, 5) = "Menu_" Then
               Select Case Y
                  Case Is < .Top
                     Exit For
                  Case Is > .Top + .Height
                     Exit For
                  Case Else
                     Select Case X
                        Case Is < .Left
                        Case Is > .Left + .Width
                        Case Else
                           ' Name zurückgeben
                           GetNameFromPoint = .Name
                           Exit For
                     End Select
               End Select
            End If
         End If
      End With
   Next
End Function

Private Sub Worksheet_Activate()
   ' Wird beim Aktivieren ausgeführt. 
Damit der
   ' Defaultbutton aktiviert wird, wird die
   ' folgende Prozedur aufgerufen
   ImageOver_MouseMove 0, 0, -10, -10
End Sub

Die Ereignisprozedur Worksheet_Activate

In dieser Ereignisprozedur, welche beim Aktivieren des Tabellenblattes abgearbeitet wird, ruft man lediglich die Ereignisprozedur ImageOver_MouseMove auf. Damit soll sichergestellt werden, dass nach einem Wechsel auf ein anderes Blatt und zurück, nicht der zuletzt gewählte Menüpunkt aktiviert bleibt. Es sollte der Defaultbutton für dieses Blatt aktiv sein, welcher in der aufgerufenen Prozedur festgelegt wird.
Das ist zum Beispiel wichtig, wenn man über solch ein Menü andere Tabellenblätter mit einem gleichen Menü aufruft. In jedem dieser Blätter sollte dann standardmäßig der Menüpunkt aktiviert sein, der auf das gleiche Tabellenblatt verweist.

Die Ereignisprozedur ImageOver_MouseDown

In dieser Ereignisprozedur, welche beim Klick auf das Bildsteuerelement abgearbeitet wird, wird durch den Aufruf der Funktion GetNameFromPoint die unter der Mausposition liegende Form zurückgeliefert und es wird dementsprechend eine Aktion ausgeführt.

Mittels Select Case wird dazu auf den zurückgelieferten Namen reagiert und in diesem Beispiel eine angepasste Messagebox angezeigt.

Das Setzen der Visible-Eigenschaft auf False und auf True wird deshalb vorgenommen, weil durch einen normalen Klick darauf das Steuerelement anschließend solange nicht mehr transparent ist, bis ein anderes Steuerelement aktiviert wird.

Die Ereignisprozedur ImageOver_MouseMove

Diese Ereignisprozedur des Bildsteuerelementes, welche beim Überfahren mit der Maus abgearbeitet wird, bildet das zentrale Element des Effekts. Da diese sehr oft aufgerufen wird, arbeite ich hier mit einigen statischen Variablen, deren Wert zwischen den Aufrufen erhalten bleibt. Die statische Objektvariable objImage nimmt einen Objektverweis auf das Bildsteuerelement auf.

Die statischen Variablen X1 und Y1 speichern die Position des Mauszeigers des vorherigen Aufrufes. Erst ab einer bestimmten Abweichung von der vorherigen Position wird die neue Position gespeichert und die Prozedur weiter ausgeführt. Nimmt man einen höheren Wert, wird die Prozedur nicht mehr so oft vollständig abgearbeitet, man spart also Zeit, aber auf Kosten der Empfindlichkeit. Bei älteren Systemen sicherlich eine Schraube, an der man noch etwas drehen kann.

Anschließend wird zum Beschleunigen Application.EnableEvents auf Falsch gesetzt, dadurch wird das Auslösen weiterer Ereignisse abgeschaltet. Aus diesem Grund ist eine Fehlerbehandlung wichtig, die sicherstellt, dass die Ereignisbehandlung auch immer wieder eingeschaltet wird.

Durch den Aufruf der Funktion GetNameFromPoint wird nun der Name der unter der Mausposition liegenden Form zurückgeliefert. An diese Funktion wird dazu die X- bzw. Y-Position des Mauszeigers übergeben, welche wiederum zuvor als Parameter an die Ereignisprozedur übergeben wurden. Da sich die Angaben auf ein Koordinatensystem im Inneren des Steuerelements beziehen, aber eine Position benötigt wird, die sich auf das Tabellenblatt bezieht, addiert man zum X-Wert den Left- und zum Y-Wert den Top-Eigenschaftswert des Steuerelements. Wird ein leerer String zurückgeliefert, setzt man das Aussehen des Mauszeigers auf den Defaultwert. Zum Zurücksetzen des Mauszeigers setzt man die MousePointer-Eigenschaft des Bildsteuerelements auf fmMousePointerDefault.

Bei einem nichtleeren String setzt man die MousePointer-Eigenschaft des Bildsteuerelements auf fmMousePointerCustom und übergibt an die Eigenschaft MouseIcon einen Cursor vom Typ StdPicture. Dieser wird zuvor mit LoadPicture aus dem Cursor-Verzeichnis des Betriebssystems ausgelesen und in der statischen Variable objCur gespeichert. In einer statischen Variable deshalb, damit man nicht immer wieder den Cursor nachladen muss.

Bei einem leeren, zurückgelieferten String wird die Variable strTemp auf den Namen des Menüpunktes gesetzt, der für dieses Blatt defaultmäßig aktiv sein soll. Zuständig dafür ist diese Zeile:
If strTemp = "" Then strTemp = "Menu_1_Hi"
Mit Hilfe dieses Namens wird das darunterliegende Shape, welches den aktiven Menüpunkt darstellen soll, sichtbar gemacht, das an gleicher Position liegende inaktive Shape wird unsichtbar gemacht. Alle anderen aktiven Shapes werden in einer For … Each-Schleife unsichtbar, die anderen inaktiven Shapes sichtbar gemacht.

Zum Schluss werden die Ereignisse wieder eingeschaltet.

Die Funktion GetNameFromPoint

In dieser Funktion wird die übergebene Position, ausgewertet. In einer Schleife durchläuft man dazu alle Shapes der Shapes-Auflistung. Beginnt der Name eines Shapes mit der Zeichenkette “Name_“, vergleicht man die übergebenen Koordinaten mit denen des aktuellen Shapes. Befindet sich die Y-Position bereits außerhalb, kann man die Funktion an dieser Stelle getrost verlassen. Befindet sie sich innerhalb des Bereiches, wird die X-Position verglichen und bei einer Übereinstimmung wird dieser Name als Funktionsergebnis zurückgegeben. Übereinstimmung bedeutet, dass die X-.Position sich innerhalb der horizontalen Grenzen einer Form mit der Zeichenkette “Name_“ am Anfang befindet.