Autor: Max Kaffl (Nepumuk)  --- Aus Excel VBA - Gruppe: Tutorials

Symbolleisten (5) - Im VBA Editor - Absolut heftig!!!

Autor: Max Kaffl (Nepumuk) - Erstellt: --      - Letzte Revision: --Gruppenthema: 5 Folgen 1 2 3 4 5 Sie sind in Folge:5
Im fünften Teil werden sie eine Symbolleiste im VBA - Editor anlegen.

Dieser Code ist erst ab Excel 2000 lauffähig!

Da im Code Ereignisse ausgewertet werden, welche in vorhergehenden Versionen nicht zur Verfügung stehen.

Setzen sie einen Verweis auf „Microsoft Visual Basic for Applications Extensibility 5.3".

Ab Excel XP muss bei "Extras - Makro - Sicherheit - Vertrauenswürdige Quellen - Zugriff auf Visual Basic-Projekt vertrauen" ein Häkchen rein.

Aus der fertigen Mappe werden wir am Ende ein Addin erstellen, welches uns als Editierhilfe im VBA - Editor dient.

Die Buttons in den Symbolleisten des VBA - Editors können keine Makros über die OnAction - Eigenschaft starten. Die Ereignisse müssen in Klassenmodulen auswerten werden. Dazu stehen verschiedene Möglichkeiten zur Auswahl. Eine davon haben sie im dritten Teil schon kennen gelernt, als wir den Ctrl+Shift - Click ausgewertet haben. Neben diesem Click - Ereignis des Buttons, können wir das Change - Ereignis der CommandbarCombobox auswerten. Die Leisten in Editor haben noch eine weitere Eigenschaft, nämlich die CommandBarEvents - Eigenschaft, die das CommandBarEvents - Objekt zurück gibt, welches uns ebenfalls ein Click - Ereignis zur Verfügung stellt. Wir werden diese drei Möglichkeiten verwenden.

Für das Projekt werden folgende Komponenten benötigt:

· Ein Standardmodul mit wahlfreiem Namen
· Ein Klassenmodul mit dem Namen clscmbButton
· Ein Klassenmodul mit dem Namen clscmbEvents
· Ein Klassenmodul mit dem Namen clsPool
· Ein Klassenmodul mit dem Namen clscmbDropdown

Kopieren sie die folgenden Routinen zum Erstellen und Löschen der Commandbar in das Standardmodul.

Starten sie das Makro prcCreateCommandBar nicht, bevor alle Codeteilen vollständig sind. Sie würden nur Fehlermeldungen produzieren. 

Option Explicit

Private Declare Sub Sleep Lib "kernel32.dll" ( _
 ByVal dwMilliseconds As Long)
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
 ByVal lpClassName As String, _
 ByVal lpWindowName As String) As Long
Private Declare Function SetTimer Lib "user32.dll" ( _
 ByVal hWnd As Long, _
 ByVal nIDEvent As Long, _
 ByVal uElapse As Long, _
 ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" ( _
 ByVal hWnd As Long, _
 ByVal nIDEvent As Long) As Long
Private Declare Function SetWindowPos Lib "user32.dll" ( _
 ByVal hWnd As Long, _
 ByVal hWndInsertAfter As Long, _
 ByVal x As Long, _
 ByVal y As Long, _
 ByVal cx As Long, _
 ByVal cy As Long, _
 ByVal wFlags As Long) As Long

Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2

Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40

Public Enum Box_Title
 lInfo
 lAdvice
 lError
 lUser
 lExcel
End Enum

Private Const COMMANDBAR_NAME = "Private_VBE_Bar"

Private objPool As clsPool

Public Sub prcCreateCommandBar()
 Dim cmbPopup As CommandBarPopup
 Dim cmbButton As CommandBarButton
 Dim cmbDropdown As CommandBarComboBox
 Dim objButton(1 To 2) As clscmbButton
 Call prcDeleteCommandBar
 Set objPool = New clsPool
 Set objPool.prpcmbBar = Application.VBE.CommandBars.Add(Name:= _
 COMMANDBAR_NAME, Position:=msoBarTop, MenuBar:=False, _
 Temporary:=True)
 Call prcControlAdd(objParent:=objPool.prpcmbBar, _
 varControl:=cmbPopup, enumType:=msoControlPopup, _
 varCaption:="&Kopfzeilen")
 Call prcControlAdd(objParent:=cmbPopup, _
 varControl:=cmbButton, enumType:=msoControlButton, _
 varCaption:="Einf&ügen", varFaceId:=296, _
 enumStyle:=msoButtonIconAndCaption, varTag:="1")
 Set objButton(1) = New clscmbButton
 Set objButton(1).mcmbButton = cmbButton
 objPool.prpcolButtons.Add objButton(1)
 Call prcControlAdd(objParent:=cmbPopup, _
 varControl:=cmbButton, enumType:=msoControlButton, _
 varCaption:="L&öschen", varFaceId:=293, _
 enumStyle:=msoButtonIconAndCaption, varTag:="2")
 Set objButton(2) = New clscmbButton
 Set objButton(2).mcmbButton = cmbButton
 objPool.prpcolButtons.Add objButton(2)
 Call prcControlAdd(objParent:=objPool.prpcmbBar, _
 varControl:=cmbButton, enumType:=msoControlButton, _
 bolBeginGroup:=True, varCaption:="Want", varFaceId:=271, _
 enumStyle:=msoButtonIconAndCaption, _
 varTipText:="Variablennamen merken", _
 enumState:=msoButtonUp, varWidth:=55)
 Set objPool.prpcmbButton = cmbButton
 Set objPool.prpobjEvents = _
 Application.VBE.Events.CommandBarEvents(cmbButton)
 Call prcControlAdd(objParent:=objPool.prpcmbBar, _
 varControl:=cmbDropdown, enumType:=msoControlDropdown, _
 varWidth:=120, varDropDownWidth:=120, varDropDownLines:=12)
 Set objPool.prpobjDropdown = cmbDropdown
 Call prcAddItems(False)
 objPool.prpcmbBar.Visible = True
 Set cmbPopup = Nothing
 Set cmbButton = Nothing
 Set cmbDropdown = Nothing
End Sub

Public Sub prcDeleteCommandBar()
 Dim cmbmyBar As CommandBar
 If Not objPool Is Nothing Then
 If Not objPool.prpcmbBar Is Nothing Then _
 objPool.prpcmbBar.Delete
 Else
 For Each cmbmyBar In Application.VBE.CommandBars
 If cmbmyBar.Name = COMMANDBAR_NAME Then _
 cmbmyBar.Delete
 Next
 End If
 Set objPool = Nothing
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, _
 Optional ByVal varWidth As Variant, _
 Optional ByVal varDropDownWidth As Variant, _
 Optional ByVal varDropDownLines As Variant)
 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
 If Not IsMissing(varWidth) Then .Width = varWidth
 If Not IsMissing(varDropDownWidth) Then _
 .DropDownWidth = varDropDownWidth
 If Not IsMissing(varDropDownLines) Then _
 .DropDownLines = varDropDownLines
 End With
 If Not IsMissing(varControl) Then Set varControl = cmbControl
 Set cmbControl = Nothing
End Sub

Private Sub prcAddItems(ByVal bolAll As Boolean)
 Dim varArray As Variant, varItem As Variant
 If bolAll Then
 varArray = Array( _
 "For - Next", _
 "For - Each", _
 "Do - Loop", _
 "While - Wend")
 Else
 varArray = Array( _
 "Do - Loop", _
 "While - Wend")
 End If
 With objPool.prpobjDropdown
 .Clear
 For Each varItem In varArray
 .AddItem varItem
 Next
 End With
End Sub

Sie werden als erstes wieder ein paar API - Aufrufe bemerken, welche später erklärt werden. Das erstellen der Commandbar und bestücken mit Steuerelenenten ist nun schon Routine und muss nicht näher erläutert werden. Auch das Verweisen an Klassen ist ihnen sicher geläufig.

Natürlich habe ich mir auch dieses mal ein paar Beispielroutinen entwickelt, aber wir wollen uns erst die Klassenmodule ansehen.

Das erste leitet aufgrund der Tag - Eigenschaft der Buttons das Click - Ereignis von zwei Buttons an zwei unterschiedliche Routinen. Die beiden Buttons werden über ein Collection - Objekt an die Klasse übergeben.

Fügen sie diesen Code in das Klassenmodul mit dem Namen "clscmbButton" ein. 

Option Explicit

Public WithEvents mcmbButton As CommandBarButton

Private Sub Class_Terminate()
 Set mcmbButton = Nothing
End Sub

Private Sub mcmbButton_Click(ByVal Ctrl As CommandBarButton, _
 CancelDefault As Boolean)
 Select Case mcmbButton.Tag
 Case "1": Call prcInsertHeadLines
 Case "2": Call prcDeleteHeadLines
 End Select
End Sub

Der dritte Button löst das Events - Ereignis des VBE - CommandBar - Objektes aus und wird mit folgender Anweisung an die Klasse übergeben.

Set objEvents.prpBarEvents = Application.VBE.Events.CommandBarEvents(cmbButton)

Sie sehen, dass sich die Click - Ereignisse unterscheiden. Das erste bekommt einen Commandbarbutton das andere ein Commandbarcontrol als Objekt übergeben. Das heißt, es lassen sich auf diese weise allen Controls der VBE - Commandbars ein Click - Ereignis zuordnen.

Natürlich ließe sich der dritte Button auch über das Click - Ereignis des Commandbarbuttons steuern, aber ich wollte ihnen diese Möglichkeit auch vorstellen. Sie steht übrigens schon in Excel97 zur Verfügung.

Fügen sie diesen Code in das Klassenmodul mit dem Namen "clscmbEvents" ein. 

Option Explicit

Private WithEvents mobjEvents As CommandBarEvents

Private Sub Class_Terminate()
 Set mobjEvents = Nothing
End Sub

Private Sub mobjEvents_Click(ByVal CommandBarControl As Object, _
 Handled As Boolean, CancelDefault As Boolean)
 Call prcTryToSaveVariable
End Sub

Friend Property Set prpBarEvents(ByVal objEvents As CommandBarEvents)
 Set mobjEvents = objEvents
End Property

Weil wir beim dritten Button verschiedene Eigenschaften durch einen Klick ändern, wurde der Button an eine eigene Klasse verwiesen.

Wir könnten das Objekt auch über Application.VBE.CommandBars(COMMANDBAR_NAME).Cotrols(2) ansprechen. Wenn sie sich aber nun entschließen, vor diesem Button noch ein anderes Control einzufügen, müssen sie im kompletten Code alle diese Objektverweise ändern. Bei der Benutzung eines Klassenmoduls, kann uns die Position des Buttons gleichgültig sein, da wir Projektweit garantiert das richtige Objekt ansprechen.

In der Klasse verwalten wir alle Variablen und Objekte, die wir sonst auf Modul- oder Projektebene hätten deklarieren müssen. Dadurch kommen wir mit einer einzigen öffentlichen Variablen aus.

Fügen sie diesen Code in das Klassenmodul mit dem Namen " clsPool" ein. 

Option Explicit

Private mcmbBar As CommandBar
Private mcmbButton As CommandBarButton
Private mcolButtons As Collection
Private menumTitle As Box_Title
Private mstrVariable As String
Private mobjEvents As clscmbEvents
Private mobjDropdown As clscmbDropdown

Private Sub Class_Initialize()
 Set mcolButtons = New Collection
 Set mobjEvents = New clscmbEvents
 Set mobjDropdown = New clscmbDropdown
End Sub

Private Sub Class_Terminate()
 Set mcolButtons = Nothing
 Set mcmbBar = Nothing
 Set mcmbButton = Nothing
 Set mobjEvents = Nothing
 Set mobjDropdown = Nothing
End Sub

Public Property Get prpcmbBar() As CommandBar
 Set prpcmbBar = mcmbBar
End Property

Public Property Set prpcmbBar(ByVal cmbBar As CommandBar)
 Set mcmbBar = cmbBar
End Property

Public Property Get prpcmbButton() As CommandBarButton
 Set prpcmbButton = mcmbButton
End Property

Public Property Set prpcmbButton(ByVal cmbButton As CommandBarButton)
 Set mcmbButton = cmbButton
End Property

Public Property Get prpcolButtons() As Collection
 Set prpcolButtons = mcolButtons
End Property

Public Property Get prpenumTitle() As Box_Title
 prpenumTitle = menumTitle
End Property

Public Property Let prpenumTitle(ByVal enumTitle As Box_Title)
 menumTitle = enumTitle
End Property

Public Property Get prpstrVariable() As String
 prpstrVariable = mstrVariable
End Property

Public Property Let prpstrVariable(ByVal strVariable As String)
 mstrVariable = strVariable
End Property

Public Property Set prpobjEvents(ByVal objEvents As CommandBarEvents)
 Set mobjEvents.prpBarEvents = objEvents
End Property

Public Property Get prpobjDropdown() As CommandBarComboBox
 Set prpobjDropdown = mobjDropdown.prpDropdown
End Property

Public Property Set prpobjDropdown(ByVal objDropdown As CommandBarComboBox)
 Set mobjDropdown.prpDropdown = objDropdown
End Property

Das Ereignis des DropDowns ist das Change - Ereignis, welches wir im vierten Klassenmodul auswerten. Dieses ist nicht vergleichbar mit dem Change - Ereignis einer Combobox. Das Change - Ereignis einer Combobox wird nur bei einer tatsächlichen Änderung seiner Value - Eigenschaft ausgelöst. Die CommandbarCombobox reagiert schon auf das auf- und zuklappen der Datenliste. Kommt also dem Click - Ereignis eines Buttons näher. Darum auch die Abfrage, ob überhaupt ein Wert ausgewählt wurde.

Fügen sie diesen Code in das Klassenmodul mit dem Namen "clscmbDropdown" ein. 

Option Explicit

Private WithEvents mcmbDropdown As CommandBarComboBox

Private Sub Class_Terminate()
 Set mcmbDropdown = Nothing
End Sub

Private Sub mcmbDropdown_Change(ByVal Ctrl As CommandBarComboBox)
 If Ctrl.Text <> "" Then Call prcTryToAddCode(Ctrl.Text)
End Sub

Friend Property Get prpDropdown() As CommandBarComboBox
 Set prpDropdown = mcmbDropdown
End Property

Friend Property Set prpDropdown(ByVal cmbDropdown As CommandBarComboBox)
 Set mcmbDropdown = cmbDropdown
End Property

Nun zu den Makros, die durch unsere Controls ausgelöst werden. Diese kommen zu der Erstellprozedur der Commandbar in das Standardmodul.

Da wir uns im Editor bewegen, haben wir es mit einem ganz neuen Objekt, nämlich dem VBE - Objekt zu tun, welches eine Eigenschaft des Application - Objektes ist. Es werden ihnen ungewohnte Eigenschaften und Methoden begegnen. Nähere Erläuterungen zu diesem Objekt finden sie in ihrer VBA - Hilfe, wenn sie VBE als Suchbegriff eingeben.

Das erste fügt unterhalb der Option - Anweisungen einen Informationsblock in das aktive Modul ein.

Das zweite Makro löscht diesen Kopf wieder. Damit dieses die Kopfzeilen von anderen Kommentaren unterscheiden kann, setzen wir beim erstellen, zwischen das Hochkomma und das erste sichtbare Zeichen, das unsichtbare Ascii - Zeichen 160. 

Public Sub prcInsertHeadLines()
 Dim lngOptionLines As Long, lngHeadLine As Long
 Dim varHeadLineArray As Variant
 Dim strHeadLine As String
 varHeadLineArray = Array("", "*", "**", "**", _
 Chr$(169) & " by: " & Application.UserName, "**", _
 "Revision: 1.00.01", "**", _
 "Revision Date: " & CStr(Date), "**", _
 "Description: New Modul", "**", "**", "*", "")
 With Application.VBE.ActiveCodePane.CodeModule
 For lngOptionLines = 1 To 5
 If Left$(Trim$(.Lines(lngOptionLines, 1)), 6) <> "Option" _
 Then Exit For
 Next
 For lngHeadLine = 0 To UBound(varHeadLineArray)
 Select Case varHeadLineArray(lngHeadLine)
 Case "": strHeadLine = ""
 Case "*": strHeadLine = "'" & Chr$(160) & String$(80, "*")
 Case "**": strHeadLine = "'" & Chr$(160) & "**" & _
  String$(76, " ") & "**"
 Case Else: strHeadLine = "'" & Chr$(160) & "**" & _
  String$(8, " ") & varHeadLineArray(lngHeadLine) & _
  String$(68 - Len(varHeadLineArray(lngHeadLine)), " ") & "**"
 End Select
 .InsertLines lngOptionLines + lngHeadLine, strHeadLine
 Next
 End With
End Sub

Public Sub prcDeleteHeadLines()
 Dim lngHeadLine As Long, lngLine As Long
 With Application.VBE.ActiveCodePane.CodeModule
 For lngHeadLine = .CountOfLines To 1 Step -1
 If InStr(1, .Lines(lngHeadLine, 1), Chr$(160)) Then
 .DeleteLines (lngHeadLine)
 If lngLine = 0 Then lngLine = lngHeadLine Else _
  lngLine = lngLine - 1
 End If
 Next
 If lngLine <> 0 Then
 For lngHeadLine = lngLine To .CountOfLines
 If Trim$(.Lines(lngLine, 1)) = "" Then _
  .DeleteLines (lngLine) Else Exit For
 Next
 End If
 End With
End Sub

Das dritte Makro versucht einen markierten Text in eine Variable zu übernehmen, welcher dann als Schleifenzähler in einer For - Next oder For Each - Next Schleife eingesetzt wird. Ist dies erfolgreich, dann bekommt der Button ein anderes Icon, eine andere Caption und zeigt die Variable im Tooltiptext an. War es erfolglos, wird eine MsgBox ausgegeben.

Wenn sie z.B. in einer Deklarationszeile mit einem Doppelklick die Variable "meineVariable" markieren und mit einem Klick auf den Button übernehmen. dann haben die damit generierten Schleifen, folgendes Aussehen: 

For meineVariable = 1 To x

Next

For Each meineVariable In x

Next



Public Sub prcTryToSaveVariable()
 Dim lngStartLine As Long, lngStartColumn As Long
 Dim lngEndColumn As Long, lngEndLine As Long
 Dim strTemp As String
 With Application.VBE.ActiveCodePane
 .GetSelection lngStartLine, lngStartColumn, _
 lngEndLine, lngEndColumn
 strTemp = .CodeModule.Lines(lngStartLine, 1)
 strTemp = Mid$( _
 strTemp, lngStartColumn, _
 lngEndColumn - lngStartColumn)
 With objPool
 .prpstrVariable = Trim$(strTemp)
 If .prpstrVariable <> "" And _
 lngStartLine = lngEndLine And _
 InStr(1, .prpstrVariable, " ") = 0 Then
 With .prpcmbButton
  .Caption = " Ok "
  .FaceId = 59
  DoEvents
  Sleep 500
  .Caption = "Have"
  .FaceId = 270
  .State = msoButtonDown
  .TooltipText = objPool.prpstrVariable
 End With
 Call prcAddItems(True)
 Else
 With .prpcmbButton
  .Caption = "Want"
  .FaceId = 271
  .State = msoButtonUp
  .TooltipText = "Variablennamen merken"
 End With
 Call prcAddItems(False)
 Call prcMsgBox(strMsgText:="Keine gültige Markierung gefunden.", _
 enumStyle:=vbExclamation, enumTitle:=lAdvice)
 End If
 End With
 End With
End Sub

Die vierte und fünfte Routine versucht, die aus dem DropDown ausgewählte Schleife, in den Editor einzufügen. Mit der Methode GetSelection wird die aktuelle Position des Cursors ermittelt. Der Code eingefügt und mit der SetSelection - Methode der Cursor neu positioniert. 

Public Sub prcTryToAddCode(ByVal strCodeName As String)
 Dim lngStartLine As Long, lngStartColumn As Long, lngDumy As Long
 With Application.VBE.ActiveCodePane
 .GetSelection lngStartLine, lngStartColumn, lngDumy, lngDumy
 With .CodeModule
 If Trim$(.Lines(lngStartLine, 1)) = "" Then
 If .ProcOfLine(lngStartLine, vbext_pk_Proc) <> "" Or _
  .ProcOfLine(lngStartLine, vbext_pk_Let) <> "" Or _
  .ProcOfLine(lngStartLine, vbext_pk_Set) <> "" Or _
  .ProcOfLine(lngStartLine, vbext_pk_Get) <> "" Then
  Call prcAddCode(strCodeName, lngStartLine, _
  lngStartColumn)
  Else
  Call prcMsgBox(strMsgText:= _
  "Nur innerhalb einer Prozedur.", _
  enumStyle:=vbExclamation, enumTitle:=lAdvice)
  End If
 Else
 Call prcMsgBox(strMsgText:="Die Zeile ist nicht leer." & vbLf & _
  vbLf & "Plazieren sie den Cursor an der Einfügemarke.", _
  enumStyle:=vbExclamation, enumTitle:=lAdvice)
 End If
 End With
 End With
End Sub

Private Sub prcAddCode(ByVal strCodeName As String, _
 ByVal lngStartLine As Long, _
 ByVal lngStartColumn As Long)
 With Application.VBE.ActiveCodePane
 Select Case strCodeName
 Case "For - Next"
 .CodeModule.ReplaceLine lngStartLine, _
  String(lngStartColumn - 1, " ") & _
  "For " & objPool.prpstrVariable & " = 1 To x" & vbCrLf & _
  String(lngStartColumn + 3, " ") & vbCrLf & _
  String(lngStartColumn - 1, " ") & "Next"
 .SetSelection lngStartLine, _
  Len(.CodeModule.Lines(lngStartLine, 1)), _
  lngStartLine, Len(.CodeModule.Lines(lngStartLine, 1)) + 1
 Case "For - Each"
 .CodeModule.ReplaceLine lngStartLine, _
  String(lngStartColumn - 1, " ") & _
  "For Each " & objPool.prpstrVariable & " In x" & vbCrLf & _
  String(lngStartColumn + 3, " ") & vbCrLf & _
  String(lngStartColumn - 1, " ") & "Next"
 .SetSelection lngStartLine, _
  Len(.CodeModule.Lines(lngStartLine, 1)), _
  lngStartLine, Len(.CodeModule.Lines(lngStartLine, 1)) + 1
 Case "Do - Loop"
 .CodeModule.ReplaceLine lngStartLine, _
  String(lngStartColumn - 1, " ") & "Do" & vbCrLf & _
  String(lngStartColumn + 3, " ") & vbCrLf & _
  String(lngStartColumn - 1, " ") & "Loop"
 .SetSelection lngStartLine + 1, lngStartColumn + 4, _
  lngStartLine + 1, lngStartColumn + 4
 Case "While - Wend"
 .CodeModule.ReplaceLine lngStartLine, _
  String(lngStartColumn - 1, " ") & "While x" & vbCrLf & _
  String(lngStartColumn + 3, " ") & vbCrLf & _
  String(lngStartColumn - 1, " ") & "Wend"
 .SetSelection lngStartLine, _
  Len(.CodeModule.Lines(lngStartLine, 1)), _
  lngStartLine, Len(.CodeModule.Lines(lngStartLine, 1)) + 1
 End Select
 End With
End Sub

Die folgenden Routinen werden benötigt, um eine MsgBox auszugeben. Wozu der Aufwand? Versuchen sie es einmal mit einem Dreizeiler, der eine MsgBox ausgibt. Starten sie diesen mit F5 aus dem Editor. Sie werden feststellen, dass sie automatisch aus dem Editor zur Tabellenansicht gelangen. Das wollen wir damit vermeiden. Da aber, wenn die Box angezeigt wird, kein Makro mehr läuft, verwenden wir einen Trick. Wir starten vor der MsgBox einen Timer. Dieser beendet sich als erstes sofort wieder. Dann sucht eine weitere Routine mit Hilfe der FindWindow - Funktion nach dem Fenster der Box. Wird es gefunden, dann passiert folgendes. Das Fenster des VBA - Editors wird mit der API - Funktion " SetWindowPos" in den Vordergrund gebracht und anschließend das Fenster der Box vor das, des Editors. Ist doch gar nicht schwer, wenn man weiß wie es geht. 

Private Sub prcMsgBox(ByVal strMsgText As String, _
 Optional ByVal enumStyle As VbMsgBoxStyle, _
 Optional ByVal enumTitle As Box_Title = lExcel)
 objPool.prpenumTitle = enumTitle
 SetTimer FindWindow("XLMAIN", Application.Caption), 0, 1, _
 AddressOf prcTimer
 MsgBox Prompt:=strMsgText, Buttons:=enumStyle, _
 Title:=fncBoxTitle
 Call SetWindowPos(Application.VBE.MainWindow.hWnd, _
 HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE _
 Or SWP_NOACTIVATE Or SWP_SHOWWINDOW)
End Sub

Private Sub prcTimer(ByVal hWnd As Long, ByVal nIDEvent As Long, _
 ByVal uElapse As Long, ByVal lpTimerFunc As Long)
 Call prcKillTimer
 Call prcSetWindow
End Sub

Private Sub prcKillTimer()
 KillTimer FindWindow("XLMAIN", Application.Caption), 0
End Sub

Private Sub prcSetWindow() '#32770 default class name for dialog boxes
 Dim lnghWnd As Long
 lnghWnd = FindWindow("#32770", fncBoxTitle)
 If lnghWnd <> 0 Then
 Call SetWindowPos(Application.VBE.MainWindow.hWnd, _
 HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE _
 Or SWP_NOACTIVATE Or SWP_SHOWWINDOW)
 Call SetWindowPos(Application.VBE.MainWindow.hWnd, _
 lnghWnd, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE _
 Or SWP_NOACTIVATE Or SWP_SHOWWINDOW)
 End If
End Sub

Private Function fncBoxTitle() As String
 Select Case objPool.prpenumTitle
 Case lInfo: fncBoxTitle = "Information"
 Case lAdvice: fncBoxTitle = "Hinweis"
 Case lError: fncBoxTitle = "Fehler"
 Case lUser: fncBoxTitle = Application.UserName
 Case lExcel: fncBoxTitle = "Microsoft Excel"
 End Select
End Function

Das letzte Makro dient nur dazu unseren Verweis zu überprüfen und gegebenenfalls neu zu setzen. Die Identifizierung erfolgt dabei über die GUID (Globally Unique Identifier), was uns unabhängig von unterschiedlichen Installationspfaden macht.

Das Makro kann einen von Anfang an fehlenden Verweis nicht setzen, da beim öffnen der Mappe ein Kompilierungsfehler erzeugt wird!!! 

Public Sub prcSetReferences()
 Dim intIndex As Integer
 Dim bolfound As Boolean
 With ThisWorkbook.VBProject.References
 For intIndex = 1 To .Count
 If .Item(intIndex).GUID = _
 "{0002E157-0000-0000-C000-000000000046}" Then
 If .Item(intIndex).IsBroken Then _
  .Remove .Item(intIndex) Else _
  bolfound = True: Exit For
 End If
 Next
 If Not bolfound Then .AddFromGuid _
 GUID:="{0002E157-0000-0000-C000-000000000046}", _
 Major:=5, Minor:=3
 End With
End Sub

Schlussendlich nun noch die Ereignisroutinen der Mappe, welche beim öffnen die Commandbar erstellen und beim schließen wieder löschen.

Diese kommen natürlich in das Klassenmodul der Mappe. 

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Call prcDeleteCommandBar
End Sub

Private Sub Workbook_Open()
 Call prcSetReferences
 Call prcCreateCommandBar
End Sub

Speichern sie die Mappe. Wählen sie im Dialog, in der unteren Combobox, als Dateityp "Microsoft Excel-Add-In (*.xla) [letzter Eintrag in der Liste]. Ob sie ihren Addin - Ordner, welcher als Standardordner angeboten wird, benutzen wollen, bleibt ihnen überlassen. Schließen sie Excel nun und öffnen sie es mit einer leeren Mappe. Wählen sie über den AddIns-Manager das erstellte Addin (eventuell über Durchsuchen). Wechseln sie in den VBA - Editor und testen das Ergebnis.

Beachten sie dabei, dass die Klassen zerstört und die Variablen zurückgesetzt werden, wenn sie diesen Code in dem Addin selbst anwenden!

Das Beispiel kann natürlich nur als Anregung gedacht sein, das ganze weiter zu entwickeln. Wie wäre es denn mit einem kleinen Userform, in welches sie ihre Kopfdaten eingeben können (diese lassen sich in der Tabelle des Addins speichern), oder einen Button zum automatischen ändern der Versionsnummer und des Revisionsdatums, oder, oder .... Ihrer Fantasie sind keine Grenzen gesetzt.

Das war jetzt wirklich schwer. Lauter neue Objekte mit ihren Eigenschaften, Methoden und Ereignissen. Verdauen sie das erst einmal. In nächsten Teil werden wir eine Commandbar in ein Userform einbauen. Nicht ein Popup, das hatten wir schon, sondern eine richtige Symbolleiste. Und wer dann immer noch nicht genug hat, der darf noch mit Hilfe von API - Funktionen eine Menüleiste in ein Userform integrieren.


Dieses Thema hat weitere Beiträge

Symbolleisten (1) - Button einfügen
Symbolleisten (2) - Erzeugen und mehr!
Symbolleisten (3) - Menüleiste (Ab E2000) - Achtung heftig!!!
Symbolleisten (4) - Pop Up (Ab E2000) - Weiter heftig!!!
Symbolleisten (5) - Im VBA Editor - Absolut heftig!!!

Weitere Artikel der Gruppe: Tutorials Aus Excel VBA
Nach oben
ToDo
Google Werbung