Autor: Max Kaffl (Nepumuk) --- Aus Excel VBA - Gruppe:
TutorialsSymbolleisten (3) - Menüleiste (Ab E2000) - Achtung heftig!!!
Autor: Max Kaffl (Nepumuk) - Erstellt: -- - Letzte Revision: --Gruppenthema: 5 Folgen 1 2 3 4 5 Sie sind in Folge:3
Im dritten Teil der Reihe, werden wird eine neue Menüleiste anlegen.
Dieser Code ist erst ab Excel 2000 lauffähig!
Achtung, im Verlaufe des Programms werden alle sichtbaren Symbolleisten ausgeblendet und einige Popup - Menüs geändert. Sollte ihnen Excel wieder Erwarten dabei abstürzen, dann "KEINE PANIK" , starten sie das Programm erneut und beenden sie es wieder. Damit werden die Änderungen an den Leisten wieder zurückgenommen.
Da in einer Menüleiste manchmal sehr viele Elemente angelegt werden müssen, werden wir uns einer andern Technik bedienen. Dabei werden alle Informationen an eine weitere Routine übergeben welche die Elemente an- und ihre Eigenschaften festlegt.
Die meisten Argumente werden optional übergeben, da wir nicht immer alle benötigen. Es werden dabei auch Datentypen verwendet, die uns Excel zur Verfügung stellt. Diese können sie aus dem Objektkatalog entnehmen, indem sie nach der entsprechenden Variablen suchen und den Variablentyp aus dem Klassenfenster entnehmen. Dies gilt sowohl für Excelkonstanten (xl...) und Officekonstanten (mso...) als auch für Visual Basic - Konstanten (vb...). Die Benutzung dieser enumerierten Konstanten hat den Vorteil, dass beim Eingeben der Übergabeparameter das Konstantenfenster aufgeht und wir beim editieren so bequem aus der Liste auswählen können.
Nun aber erst mal die Hauptroutinen.
Bitte starten sie diese erst, wenn alle Codeteile vollständig sind. Denn auch dieses mal kommen die notwendigen Routinen, erst nach und nach dazu.
Kopieren sie die folgenden Makros in ein Standardmodul.
Option Explicit
Option Private Module
Private Const MENUBAR_NAME As String = "Privat_Menubar"
Private ccmbCommandBarButton As clsCommandBarButton
Public cmbmyMenubar As CommandBar
Public Sub prcCreateCommandBar()
Dim cmbCommandBarPopup(1 To 2) As CommandBarPopup
Dim cmbCommandBarButton As CommandBarButton
Call prcDeleteCommandBar(False)
Set cmbmyMenubar = Application.CommandBars.Add(Name:=MENUBAR_NAME, _
Position:=msoBarTop, MenuBar:=True, Temporary:=True)
Call prcControlAdd(objParent:=cmbmyMenubar, _
varControl:=cmbCommandBarPopup(1), enumType:=msoControlPopup, _
varCaption:="&Datei")
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), varId:=18)
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), varId:=23)
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), varId:=106)
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), varId:=3, _
bolBeginGroup:=True)
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), varId:=4)
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), varId:=752, _
bolBeginGroup:=True)
Call prcControlAdd(objParent:=cmbmyMenubar, _
varControl:=cmbCommandBarPopup(1), enumType:=msoControlPopup, _
varCaption:="&Bearbeiten")
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), varId:=128)
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), varId:=37)
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), varId:=21, _
bolBeginGroup:=True)
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), varId:=19)
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), varId:=22)
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), varId:=755)
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), varId:=1849, _
bolBeginGroup:=True)
Call prcControlAdd(objParent:=cmbmyMenubar, _
varControl:=cmbCommandBarPopup(1), enumType:=msoControlPopup, _
varCaption:="Date&n")
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), varId:=928)
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), varId:=30031)
Call prcControlAdd(objParent:=cmbmyMenubar, _
varControl:=cmbCommandBarPopup(1), enumType:=msoControlPopup, _
varCaption:="Menü 1")
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), _
enumType:=msoControlButton, varCaption:="Mein Makro 1", _
varFaceId:=1, varOnAction:="prcChangeStatus", _
enumStyle:=msoButtonIconAndCaption, enumState:=msoButtonUp)
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), _
enumType:=msoControlButton, varCaption:="Mein Makro 2", _
varFaceId:=444, varOnAction:="prcChangeStatus", _
enumStyle:=msoButtonIconAndCaption, enumState:=msoButtonDown, _
varTag:="445")
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), _
varControl:=cmbCommandBarPopup(2), enumType:=msoControlPopup, _
varCaption:="Menü 2")
Call prcControlAdd(objParent:=cmbCommandBarPopup(2), _
enumType:=msoControlButton, varCaption:="Mein Makro 3", _
varFaceId:=1017, varOnAction:="prcChangeFaceId", _
enumStyle:=msoButtonIconAndCaption, varTag:="1018")
Call prcControlAdd(objParent:=cmbCommandBarPopup(2), _
enumType:=msoControlButton, varCaption:="Mein Makro 4", _
varFaceId:=70, varOnAction:="prcChangeFaceId", _
enumStyle:=msoButtonIconAndCaption)
Call prcControlAdd(objParent:=cmbCommandBarPopup(2), _
enumType:=msoControlButton, varCaption:="Nicht gedrückt", _
varFaceId:=276, varOnAction:="prcChangeAll", _
enumStyle:=msoButtonIconAndCaption, varTag:="59~gedrückt")
Call prcControlAdd(objParent:=cmbmyMenubar, _
varControl:=cmbCommandBarPopup(1), enumType:=msoControlPopup, _
varCaption:="&?")
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), varId:=984)
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), varId:=1004)
Call prcControlAdd(objParent:=cmbCommandBarPopup(1), _
varControl:=cmbCommandBarButton, varId:=927)
Set ccmbCommandBarButton = New clsCommandBarButton
Set ccmbCommandBarButton.prpCommandBarButton = cmbCommandBarButton
With cmbmyMenubar
.Protection = msoBarNoCustomize + msoBarNoResize _
+ msoBarNoChangeVisible + msoBarNoChangeDock
.Visible = True
End With
Set cmbCommandBarPopup(1) = Nothing
Set cmbCommandBarPopup(2) = Nothing
Set cmbCommandBarButton = Nothing
End Sub
Public Sub prcDeleteCommandBar(ByVal bolEnabled As Boolean)
If Not cmbmyMenubar Is Nothing Then
cmbmyMenubar.Delete
Set cmbmyMenubar = Nothing
Else
For Each cmbmyMenubar In Application.CommandBars
If cmbmyMenubar.Name = MENUBAR_NAME Then cmbmyMenubar.Delete
Next
End If
Set ccmbCommandBarButton = Nothing
Call prcEnableCommandBar(bolEnabled)
End Sub
Private Sub prcControlAdd( _
ByRef objParent As Object, _
Optional ByRef varControl As Variant, _
Optional ByVal enumType As MsoControlType, _
Optional ByVal varId As Variant, _
Optional ByVal varBefore As Variant, _
Optional ByVal varTemporary As Variant, _
Optional ByVal bolBeginGroup As Boolean = False, _
Optional ByVal varCaption As Variant, _
Optional ByVal varFaceId As Variant, _
Optional ByVal varOnAction As Variant, _
Optional ByVal enumStyle As MsoButtonStyle, _
Optional ByVal varTipText As Variant, _
Optional ByVal enumState As MsoButtonState, _
Optional ByVal varTag As Variant, _
Optional ByVal enumLinkType As MsoCommandBarButtonHyperlinkType, _
Optional ByVal bolEnabled As Boolean = True, _
Optional ByVal bolVisible As Boolean = True)
Dim cmbControl As CommandBarControl
Select Case IIf(enumType, 1, 0) & IIf(IsMissing(varId), 0, 1) & _
IIf(IsMissing(varBefore), 0, 1) & IIf(IsMissing(varTemporary), 0, 1)
Case "0100": Set cmbControl = objParent.Controls.Add(ID:=varId)
Case "0101": Set cmbControl = objParent.Controls.Add(ID:=varId, _
Temporary:=varTemporary)
Case "0110": Set cmbControl = objParent.Controls.Add(ID:=varId, _
Before:=varBefore)
Case "0111": Set cmbControl = objParent.Controls.Add(ID:=varId, _
Before:=varBefore, Temporary:=varTemporary)
Case "1000": Set cmbControl = objParent.Controls.Add(Type:=enumType)
Case "1001": Set cmbControl = objParent.Controls.Add(Type:=enumType, _
Temporary:=varTemporary)
Case "1010": Set cmbControl = objParent.Controls.Add(Type:=enumType, _
Before:=varBefore)
Case "1011": Set cmbControl = objParent.Controls.Add(Type:=enumType, _
Before:=varBefore, Temporary:=varTemporary)
Case "1100": Set cmbControl = objParent.Controls.Add(Type:=enumType, _
ID:=varId)
Case "1101": Set cmbControl = objParent.Controls.Add(Type:=enumType, _
ID:=varId, Temporary:=varTemporary)
Case "1110": Set cmbControl = objParent.Controls.Add(Type:=enumType, _
ID:=varId, Before:=varBefore)
Case "1111": Set cmbControl = objParent.Controls.Add(Type:=enumType, _
ID:=varId, Before:=varBefore, Temporary:=varTemporary)
End Select
With cmbControl
.BeginGroup = bolBeginGroup
If Not IsMissing(varCaption) Then .Caption = varCaption
If Not IsMissing(varFaceId) Then .FaceId = varFaceId
If Not IsMissing(varOnAction) Then .OnAction = varOnAction
If enumStyle Then .Style = enumStyle
If Not IsMissing(varTipText) Then .TooltipText = varTipText
If enumState Then .State = enumState
If Not IsMissing(varTag) Then .Tag = varTag
If enumLinkType Then .HyperlinkType = enumLinkType
.Enabled = bolEnabled
.Visible = bolVisible
End With
If Not IsMissing(varControl) Then Set varControl = cmbControl
Set cmbControl = Nothing
End Sub
Nein, das ist nicht kompliziert, sondern nur gewöhnungsbedürftig. Wenn ich die Buttons so angelegt hätte, wie im zweiten Teil, dann wären sie jetzt mit scrollen noch nicht fertig.
Sie sollten sich solche standardisierten Routinen angewöhnen, die erleichtern das Leben ungemein.
Aber das anlegen von Buttons ist nichts neues, was neu ist, sind die Buttons, die wir uns von Excel ausleihen. Wozu sollten wird eine Speicherroutine schreiben, wenn wir sie von Excel frei Haus bekommen. Dazu müssen wir aber die ID - Nummern der einzelnen Elemente kennen.
Ganz oben auf der Seite finden sie einen Link zu einem Makro, mit dem sie sich diese anzeigen lassen können.
Die folgenden Routinen blenden die Originalleisten aus und unsere ein. Zusätzlich werden in den Popup - Menüs die Punkte "Speichern unter" (ID = 748) und "Code anzeigen" (ID = 1561) ausgeblendet. Das Popupmenü der Tabellenreiter ("Ply") wird komplett ausgeblendet. Alle anderen Popups bleiben erhalten.
Zum Schutz unserer Menübar wird das Menü "Anpassen" ("Toolbar List") ausgeblendet und der Doppelklick unterdrückt.
Mit einem kleinen Trick, können wir auch eine Eigenschaft der Commandbars, aus Excel XP und höher, in einem Code für Excel 2000 unterbringen. Dazu übergeben wir das Commandbar - Auflistungsobjekt an eine Objektvariable bei welcher die Eigenschaft ("DisableCustomize") geändert wird. Würden wir das auf das Commandbar - Objekt anwenden, würde in Excel 2000 ein Kompilierungsfehler entstehen, da das Objekt in dieser Version diese Eigenschaft nicht hat. Eine, als Objekt deklarierte Variable, hat keine spezifischen Eigenschaften und akzeptiert sie darum. Durch eine abfrage der Version müssen wir nur die Ausführung der Anweisung steuern.
Die Routine zum aus- und einschalten von Menüpunkten ist wieder eine Standardroutine. Sie wird ihnen, im weiteren Verlauf der Reihe, sicher noch mal unterkommen.
Fügen sie die Makros unter dem bisherigen Code ein.
Public Sub prcEnableCommandBar(ByVal bolEnabled As Boolean)
Dim cmbCommandBar As CommandBar
Dim objCommandBars As Object
For Each cmbCommandBar In Application.CommandBars
With cmbCommandBar
If .Name <> MENUBAR_NAME Then
If .Type <> msoBarTypePopup Then
.Enabled = bolEnabled
Else
Call prcEnableCommandBarControl( _
bolEnabled:=bolEnabled, bolVisible:=bolEnabled, _
cmbCommandBar:=cmbCommandBar, varId:=748)
Call prcEnableCommandBarControl( _
bolEnabled:=bolEnabled, bolVisible:=bolEnabled, _
cmbCommandBar:=cmbCommandBar, varId:=1561)
End If
Else
.Enabled = Not bolEnabled
.Visible = Not bolEnabled
End If
End With
Next
With Application
.EnableCancelKey = IIf(bolEnabled, xlInterrupt, xlDisabled)
If Val(.Version) > 9 Then
Set objCommandBars = .CommandBars
objCommandBars.DisableCustomize = Not bolEnabled
Set objCommandBars = Nothing
End If
.CommandBars("Toolbar List").Enabled = bolEnabled
.CommandBars("Ply").Enabled = bolEnabled
.OnDoubleClick = IIf(bolEnabled, "", "prcDoNothing")
End With
End Sub
Private Sub prcEnableCommandBarControl( _
ByVal bolEnabled As Boolean, _
ByVal bolVisible As Boolean, _
ByRef cmbCommandBar As CommandBar, _
Optional ByVal enumType As MsoControlType, _
Optional ByVal varId As Variant, _
Optional ByVal varTag As Variant, _
Optional ByVal bolVisibleControl As Boolean = False, _
Optional ByVal bolRecursive As Boolean = True)
Dim cmbCommandBarControl As CommandBarControl
Dim bolUnprotect As Boolean
Select Case IIf(enumType, 1, 0) & IIf(IsMissing(varId), 0, 1) & _
IIf(IsMissing(varTag), 0, 1)
Case "001": Set cmbCommandBarControl = cmbCommandBar.FindControl( _
Tag:=varTag, Visible:=bolVisibleControl, _
Recursive:=bolRecursive)
Case "010": Set cmbCommandBarControl = cmbCommandBar.FindControl( _
ID:=varId, Visible:=bolVisibleControl, Recursive:=bolRecursive)
Case "011": Set cmbCommandBarControl = cmbCommandBar.FindControl( _
ID:=varId, Tag:=varTag, Visible:=bolVisibleControl, _
Recursive:=bolRecursive)
Case "100": Set cmbCommandBarControl = cmbCommandBar.FindControl( _
Type:=enumType, Visible:=bolVisibleControl, _
Recursive:=bolRecursive)
Case "101": Set cmbCommandBarControl = cmbCommandBar.FindControl( _
Type:=enumType, Tag:=varTag, Visible:=bolVisibleControl, _
Recursive:=bolRecursive)
Case "110": Set cmbCommandBarControl = cmbCommandBar.FindControl( _
Type:=enumType, ID:=varId, Visible:=bolVisibleControl, _
Recursive:=bolRecursive)
Case "111": Set cmbCommandBarControl = cmbCommandBar.FindControl( _
Type:=enumType, ID:=varId, Tag:=varTag, _
Visible:=bolVisibleControl, Recursive:=bolRecursive)
End Select
If Not cmbCommandBarControl Is Nothing Then
If cmbCommandBar.Protection And msoBarNoCustomize Then
cmbCommandBar.Protection = cmbCommandBar.Protection - _
msoBarNoCustomize
bolUnprotect = True
End If
With cmbCommandBarControl
.Enabled = bolEnabled
.Visible = bolVisible
End With
If bolUnprotect Then cmbCommandBar.Protection = _
cmbCommandBar.Protection + msoBarNoCustomize
End If
End Sub
Private Sub prcDoNothing()
' This procedur do nothing
End Sub
Die nun folgenden Makros, sind kleine Spielereien zum Thema Icon und Caption von Commandbarbuttons. Die Buttons ohne Icon zeigen dabei, im Zustand "gedrückt", ein Häkchen an.
Auch diese kommen in das Standardmodul.
Private Sub prcChangeStatus()
Dim strNewTag As String
With Application.CommandBars.ActionControl
.State = IIf(.State = msoButtonUp, msoButtonDown, msoButtonUp)
If Trim$(.Tag) <> "" Then
strNewTag = CStr(.FaceId)
.FaceId = CLng(.Tag)
.Tag = strNewTag
End If
End With
End Sub
Private Sub prcChangeFaceId()
Dim lngOldFaceId As Long
With Application.CommandBars.ActionControl
lngOldFaceId = .FaceId
If Trim$(.Tag) <> "" Then
.FaceId = CLng(.Tag)
.Tag = CStr(lngOldFaceId)
Else
lngOldFaceId = lngOldFaceId + 1
If lngOldFaceId = 80 Then lngOldFaceId = 70
.FaceId = lngOldFaceId
End If
End With
End Sub
Private Sub prcChangeAll()
Dim strNewTag As String
With Application.CommandBars.ActionControl
strNewTag = CStr(.FaceId) & "~" & .Caption
.FaceId = CLng(Split(.Tag, "~")(0))
.Caption = Split(.Tag, "~")(1)
.Tag = strNewTag
End With
End Sub
Da wir als Programmierer uns einen kleinen Notausgang offen halten, damit wir in der Mappe richtig arbeiten können, legen wir eine versteckte Funktion auf einen der Buttons. Nämlich dem Info - Button im Hilfemenü. Dazu benötigen wir ein Klassenmodul mit dem Namen "clsCommandBarButton". Dieses legen sie über das Menü Einfügen - Klassenmodul an. Den Namen können sie im Eigenschaftsfenster ändern. Die Zuweisung des Buttons an das Klassenmodul, erfolgt aus der Hauptroutine heraus über eine Property Set - Prozedur.
Der folgende Code kommt in dieses Klassenmodul.
Option Explicit
Private Declare Function GetKeyboardState Lib "user32.dll" ( _
kbArray As KeyboardBytes) As Long
Private Type KeyboardBytes
kbByte(0 To 255) As Byte
End Type
Private Const VK_SHIFT = &H10
Private Const VK_CONTROL = &H11
Private WithEvents mcmdCommandBarButton As CommandBarButton
Private Sub mcmdCommandBarButton_Click(ByVal Ctrl As CommandBarButton, _
CancelDefault As Boolean)
Dim udtkbArray As KeyboardBytes
Call GetKeyboardState(udtkbArray)
If udtkbArray.kbByte(VK_SHIFT) > 1 And _
udtkbArray.kbByte(VK_CONTROL) > 1 Then
' mit Shifttaste und Controltaste
Call prcDeleteCommandBar(True)
ElseIf udtkbArray.kbByte(VK_SHIFT) > 1 Then
' mit Shifttaste
ElseIf udtkbArray.kbByte(VK_CONTROL) > 1 Then
' mit Controltaste
Else
' ohne Taste
End If
End Sub
Public Property Set prpCommandBarButton( _
ByVal ccmdCommandBarButton As CommandBarButton)
Set mcmdCommandBarButton = ccmdCommandBarButton
End Property
Als Ereignis wird der Klick auf den Button ausgewertet. Dabei wird über die API - Funktion " GetKeyboardState" der Status der Tastatur ausgelesen und die Shift- und Control- Taste ausgewertet. Sind diese beiden Tasten beim Klick auf den Button gedrückt, werden die normalen Symbolleisten wiederhergestellt. Auf diese Art lassen sich mit jeden Button vier verschiedene Routinen starten. Wenn der Button zusätzlich eine OnAction - Eigenschaft hat, wird deren Makro immer mit ausgelöst.
Nun noch die Routinen, welche unsere Leiste aufrufen, sowie beim Mappenwechsel ein- und ausblenden. Diese gehören, wie sie sicher wissen, in das Klassenmodul der Mappe.
Option Explicit
Private Sub Workbook_Activate()
If Not cmbmyMenubar Is Nothing Then
Application.ScreenUpdating = False
Call prcEnableCommandBar(False)
Application.ScreenUpdating = True
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
With ThisWorkbook
If Not .Saved Then
Select Case MsgBox("Änderungen speichern?", 35, "Abfrage")
Case 2
Cancel = True
Exit Sub
Case 6: .Save
Case 7: .Saved = True
End Select
End If
End With
Call prcDeleteCommandBar(True)
End Sub
Private Sub Workbook_Deactivate()
If Not cmbmyMenubar Is Nothing Then
Application.ScreenUpdating = False
Call prcEnableCommandBar(True)
Application.ScreenUpdating = True
End If
End Sub
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Call prcCreateCommandBar
Application.ScreenUpdating = True
End Sub
Jetzt die Mappe speichern, schließen und wieder öffnen. Toll, oder?
Diesmal war es wirklich gar nicht so einfach. Beim nächsten mal werden sie das Popupmenü kennen lernen. Das wird dann eine richtige Entspannungsübung.
Weitere Artikel der Gruppe: Tutorials Aus Excel VBA
Nach oben