PDA

Vollständige Version anzeigen : Menüleiste über VBA


jinx
20.09.2001, 19:26
<font size="2" face="Century Gothic">Moin,

seit Excel97 ist die Menüleiste ein Teil der Symbolleisten und wird in dieser Aufzählung geführt (im englischen: CommandBars). Eine Beschreibung, wie ohne VBA Veränderungen durchgeführt werden können, meine ich im Beitrag Anlegen, Ausführen und Anbinden von Makros (http://www.ms-office-forum.net/forum/showthread.php?s=&threadid=86696) gegeben zu haben. Dieses Thema wird sich ausschließlich um Beiträge per VBA zur Menüleiste widmen.

Wenn die Menüleiste "verschwunden" ist, hilft leider das Vorgehen mit Wiederherstellen aus dem Anpassen-Menü der Symbolleisten nicht; dies muß nach meinem Kenntnisstand per VBA erfolgen. Die folgenden Makro sollten dabei zum gewünschten Erfolg führen - für den Fall, dass die Menüleiste gerade noch "ansichtig" ist, wurden die entsprechenden Makros zum Ausblenden ebenfalls angefügt.

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> MenueleisteEinblenden()
<span class="REM"> ' blendet die &quot;verschwundene&quot; Menueleiste wieder ein</span>
<span class="REM"> ' verwendet den englischen Namen der Leiste</span>
Application.CommandBars(&quot;Worksheet Menu Bar&quot;).Enabled = <span class="TOKEN">True</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr><span class="TOKEN">Sub</span> MenueleisteEinblendenIndex()
<span class="REM"> ' verwendet den Index der Leiste aus der Aufz&auml;hlung Commandbars</span>
Application.CommandBars(1).Enabled = <span class="TOKEN">True</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr>&nbsp;
<span class="TOKEN">Sub</span> MenueleisteAusblenden()
<span class="REM"> ' blendet die Menueleiste aus</span>
<span class="REM"> ' verwendet den englischen Namen der Leiste</span>
Application.CommandBars(&quot;Worksheet Menu Bar&quot;).Enabled = <span class="TOKEN">False</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr><span class="TOKEN">Sub</span> MenueleisteAusblendenIndex()
<span class="REM"> ' verwendet den Index der Leiste aus der Aufz&auml;hlung Commandbars</span>
Application.CommandBars(1).Enabled = <span class="TOKEN">False</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>

Hat man bei der Bearbeitung der Menüleiste einen "falschen Weg" eingeschlagen, so läßt sich durch das folgende Makro der <b>Originalzustand</b> (!!!) wieder herstellen - dabei gehen alle individuellen Veränderungen verloren:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> MenuleisteResetten()
<span class="REM"> ' verwendet den englischen Namen der Leiste</span>
<span class="REM"> ' Achtung: alle (!) Aenderungen der Menueleiste werden rueckgaengig gemacht</span>
Application.CommandBars(&quot;Worksheet Menu Bar&quot;).Reset
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>

Wie in den ersten Codings bereits angeführt, benötigen wir zur Ansprache der Menüleiste entweder deren englischen Namen oder den Index, im Falle der Menüleiste einfach (steht ja oben), für die anderen Symbolleisten kann ein Vorgehen wie folgend helfen, welches die Angaben auf eine Tabelle Ausgabe schreibt:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> ShowCommandBarNames()
<span class="TOKEN">Dim</span> cBar <span class="TOKEN">As</span> CommandBar
<span class="TOKEN">Dim</span> iRow <span class="TOKEN">As</span> <span class="TOKEN">Integer</span>
<span class="TOKEN">Const</span> cstrTabelle <span class="TOKEN">As</span> <span class="TOKEN">String</span> = &quot;Ausgabe&quot;
&nbsp;
<span class="TOKEN">On Error GoTo</span> ShowCommandBarNames_Error
Application.ScreenUpdating = <span class="TOKEN">False</span>
<span class="TOKEN">With</span> Sheets(cstrTabelle)
.UsedRange.Clear
iRow = 1
.Range(.Cells(iRow, 1), .Cells(iRow, 3)) = Array(&quot;LfdNr&quot;, &quot;Name&quot;, &quot;Art&quot;)
<span class="TOKEN">For</span> <span class="TOKEN">Each</span> cBar <span class="TOKEN">In</span> CommandBars
iRow = iRow + 1
.Cells(iRow, 1) = cBar.Index
.Cells(iRow, 2) = cBar.Name
Select Case cBar.Type
Case msoBarTypeNormal
.Cells(iRow, 3) = &quot;Symbolleiste&quot;
Case msoBarTypeMenuBar
.Cells(iRow, 3) = &quot;Men&uuml;leiste&quot;
Case msoBarTypePopup
.Cells(iRow, 3) = &quot;Kontextmen&uuml;&quot;
<span class="TOKEN">Case Else</span>
<span class="REM"> ' sollte je eigentlich nicht vorkommen ;-)</span>
.Cells(iRow, 3) = &quot;nicht bekannt&quot;
<span class="TOKEN">End</span> Select
<span class="TOKEN">Next</span> cBar
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
&nbsp;
Exit_Here:
Application.ScreenUpdating = <span class="TOKEN">True</span>
<span class="TOKEN">On Error GoTo 0</span>
<span class="TOKEN">Exit Sub</span>
&nbsp;
ShowCommandBarNames_Error:
MsgBox &quot;Fehler &quot; &amp; Err.Number &amp; vbCrLf &amp; &quot;Beschreibung: &quot; &amp; Err.Description &amp; vbCrLf &amp; _
&quot;Ort: Prozedur ShowCommandBarNames&quot; &amp; vbCrLf &amp; &quot;Modul basCommandbars&quot;, vbCritical, &quot;Fehlermeldung&quot;
<span class="TOKEN">Resume</span> Exit_Here
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>

Da der Menüleiste im Rahmen dieses Themas der Schwerpunkt zukommen soll, werden im folgenden Makro die momentane Nummer der Reihenfolge und der deutsche Name sowie der Accelerator (das Zeichen, weches zusammen mit der ALT-Taste die Bedienung über die Tastatur ermöglicht) angegeben:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> ShowMenuBarNames()
<span class="TOKEN">Dim</span> cbControl <span class="TOKEN">As</span> CommandBarControl
<span class="TOKEN">Dim</span> iRow <span class="TOKEN">As</span> <span class="TOKEN">Integer</span>
<span class="TOKEN">Const</span> cstrTabelle <span class="TOKEN">As</span> <span class="TOKEN">String</span> = &quot;Ausgabe&quot;
&nbsp;
<span class="TOKEN">On Error GoTo</span> ShowMenuBarNames_Error
Application.ScreenUpdating = <span class="TOKEN">False</span>
<span class="TOKEN">With</span> Sheets(cstrTabelle)
.UsedRange.Clear
iRow = 1
.Range(.Cells(iRow, 1), .Cells(iRow, 2)) = Array(&quot;LfdNr&quot;, &quot;Name und Accelerator&quot;)
<span class="TOKEN">For</span> <span class="TOKEN">Each</span> cbControl <span class="TOKEN">In</span> Application.CommandBars(1).Controls
iRow = iRow + 1
.Cells(iRow, 1) = iRow - 1
.Cells(iRow, 2) = cbControl.Caption
<span class="TOKEN">Next</span> cbControl
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
&nbsp;
Exit_Here:
Application.ScreenUpdating = <span class="TOKEN">False</span>
<span class="TOKEN">On Error GoTo 0</span>
<span class="TOKEN">Exit Sub</span>
&nbsp;
ShowMenuBarNames_Error:
MsgBox &quot;Fehler &quot; &amp; Err.Number &amp; vbCrLf &amp; &quot;Beschreibung: &quot; &amp; Err.Description &amp; vbCrLf &amp; _
&quot;Ort: Prozedur ShowMenuBarNames&quot; &amp; vbCrLf &amp; &quot;Modul basCommandbars&quot;, vbCritical, &quot;Fehlermeldung&quot;
<span class="TOKEN">Resume</span> Exit_Here
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span>
&nbsp;</pre></div>

Tja, und da hätten wir dann gerne wieder ein Problem, denn die deutschen Angaben sind ja nett, aber wie setze ich es für den Kollegen mit einer anderen Landessprache um? Die Index-Nummer für einen Eintrag kann sich verschoben haben - wenn sich z.B. ein AddIn "eingenistet" hat, welches die normale Reihenfolge durcheinander gebracht hat. Diese Vorgehensweise ist dann nicht der Weisheit letzter Schluß...

Eine Liste mit den ID´s und den deutschen Namen können wir uns auf die folgende Art anzeigen lassen:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> ShowMenuBarIDs()
<span class="TOKEN">Dim</span> cbControl <span class="TOKEN">As</span> CommandBarControl
<span class="TOKEN">Dim</span> iRow <span class="TOKEN">As</span> <span class="TOKEN">Integer</span>
<span class="TOKEN">Const</span> cstrTabelle <span class="TOKEN">As</span> <span class="TOKEN">String</span> = &quot;Ausgabe&quot;
&nbsp;
<span class="TOKEN">On Error GoTo</span> ShowMenuBarIDs_Error
&nbsp;
Application.ScreenUpdating = <span class="TOKEN">False</span>
<span class="TOKEN">With</span> Sheets(cstrTabelle)
.UsedRange.Clear
iRow = 1
.Range(.Cells(iRow, 1), .Cells(iRow, 2)) = Array(&quot;ID Men&uuml;&quot;, &quot;Name&quot;)
<span class="TOKEN">For</span> <span class="TOKEN">Each</span> cbControl <span class="TOKEN">In</span> Application.CommandBars(1).Controls
iRow = iRow + 1
.Cells(iRow, 1) = cbControl.ID
.Cells(iRow, 2) = cbControl.Caption
<span class="TOKEN">Next</span> cbControl
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
&nbsp;
Exit_Here:
<span class="TOKEN">On Error GoTo 0</span>
<span class="TOKEN">Exit Sub</span>
&nbsp;
ShowMenuBarIDs_Error:
MsgBox &quot;Fehler &quot; &amp; Err.Number &amp; vbCrLf &amp; &quot;Beschreibung: &quot; &amp; Err.Description &amp; vbCrLf &amp; _
&quot;Ort: Prozedur ShowMenuBarIDs&quot; &amp; vbCrLf &amp; &quot;Modul basCommandbars&quot;, vbCritical, &quot;Fehlermeldung&quot;
<span class="TOKEN">Resume</span> Exit_Here
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>

Mit folgendem Code kann aus dem Menüpunkt <i>Datei</i> ausgelesen werden, welche IDs die einzelnen Menübefehle haben. Das erste Vorgehen benutzt dazu den lokalen Namen des Menüpunktes:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> ShowMenuFileIDs()
<span class="TOKEN">Dim</span> cbControl <span class="TOKEN">As</span> CommandBarControl
<span class="TOKEN">Dim</span> iRow <span class="TOKEN">As</span> <span class="TOKEN">Integer</span>
<span class="TOKEN">Const</span> cstrTabelle <span class="TOKEN">As</span> <span class="TOKEN">String</span> = &quot;Ausgabe&quot;
&nbsp;
<span class="TOKEN">On Error GoTo</span> ShowMenuFileIDs_Error
&nbsp;
Application.ScreenUpdating = <span class="TOKEN">False</span>
<span class="TOKEN">With</span> Sheets(cstrTabelle)
.UsedRange.Clear
iRow = 1
.Range(.Cells(iRow, 1), .Cells(iRow, 2)) = Array(&quot;ID Datei&quot;, &quot;Name&quot;)
<span class="TOKEN">For</span> <span class="TOKEN">Each</span> cbControl <span class="TOKEN">In</span> Application.CommandBars(1).Controls(&quot;Datei&quot;).Controls
iRow = iRow + 1
.Cells(iRow, 1) = cbControl.ID
.Cells(iRow, 2) = cbControl.Caption
<span class="TOKEN">Next</span> cbControl
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
&nbsp;
Exit_Here:
<span class="TOKEN">On Error GoTo 0</span>
<span class="TOKEN">Exit Sub</span>
&nbsp;
ShowMenuFileIDs_Error:
MsgBox &quot;Fehler &quot; &amp; Err.Number &amp; vbCrLf &amp; &quot;Beschreibung: &quot; &amp; Err.Description &amp; vbCrLf &amp; _
&quot;Ort: Prozedur ShowMenuFileIDs&quot; &amp; vbCrLf &amp; &quot;Modul basCommandbars&quot;, vbCritical, &quot;Fehlermeldung&quot;
<span class="TOKEN">Resume</span> Exit_Here
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>

Für das zweite Vorgehen setzen wir die Methode FindControl und die ID des Menüs ein:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> ShowMenuFileIDsWithIDs()
<span class="TOKEN">Dim</span> cbPopup <span class="TOKEN">As</span> CommandBarPopup
<span class="TOKEN">Dim</span> cbControl <span class="TOKEN">As</span> CommandBarControl
<span class="TOKEN">Dim</span> iRow <span class="TOKEN">As</span> <span class="TOKEN">Integer</span>
<span class="TOKEN">Const</span> cstrTabelle <span class="TOKEN">As</span> <span class="TOKEN">String</span> = &quot;Ausgabe&quot;
&nbsp;
<span class="TOKEN">On Error GoTo</span> ShowMenuFileIDsWithIDs_Error
&nbsp;
Application.ScreenUpdating = <span class="TOKEN">False</span>
<span class="TOKEN">With</span> Sheets(cstrTabelle)
.UsedRange.Clear
iRow = 1
.Range(.Cells(iRow, 1), .Cells(iRow, 2)) = Array(&quot;ID Datei&quot;, &quot;Name&quot;)
<span class="TOKEN">Set</span> cbPopup = Application.CommandBars.FindControl _
(Type:=msoControlPopup, ID:=30002)
<span class="TOKEN">For</span> <span class="TOKEN">Each</span> cbControl <span class="TOKEN">In</span> cbPopup.Controls
iRow = iRow + 1
.Cells(iRow, 1) = cbControl.ID
.Cells(iRow, 2) = cbControl.Caption
<span class="TOKEN">Next</span> cbControl
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
&nbsp;
Exit_Here:
<span class="TOKEN">On Error GoTo 0</span>
<span class="TOKEN">Set</span> cbPopup = <span class="TOKEN">Nothing</span>
<span class="TOKEN">Exit Sub</span>
&nbsp;
ShowMenuFileIDsWithIDs_Error:
MsgBox &quot;Fehler &quot; &amp; Err.Number &amp; vbCrLf &amp; &quot;Beschreibung: &quot; &amp; Err.Description &amp; vbCrLf &amp; _
&quot;Ort: Prozedur ShowMenuFileIDsWithIDs&quot; &amp; vbCrLf &amp; &quot;Modul basCommandbars&quot;, vbCritical, &quot;Fehlermeldung&quot;
<span class="TOKEN">Resume</span> Exit_Here
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>
Code eingefügt mit dem MOF Code Converter (http://www.ms-office-forum.net/forum/codeconverter.php)</font>

jinx
02.11.2001, 21:35
<font size="2" face="Century Gothic">Moin,


dann wollen wir uns doch einmal daran machen, die ganzen Befehle eines Menüpunktes "außer Gefecht" zu setzen. Dazu bedienen wir uns einer Schleife, die alle Befehle innerhalb des Punktes durchläuft. Als Beispiel soll dafür das Menü Extras herhalten:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> MenuebefehleExtrasDeaktivieren()
<span class="TOKEN">Dim</span> cbControl <span class="TOKEN">As</span> CommandBarControl
<span class="TOKEN">On Error GoTo</span> MenuebefehleExtrasDeaktivieren_Error
&nbsp;
<span class="TOKEN">For</span> <span class="TOKEN">Each</span> cbControl <span class="TOKEN">In</span> Application.CommandBars(&quot;Tools&quot;).Controls
cbControl.Enabled = <span class="TOKEN">False</span>
<span class="TOKEN">Next</span> cbControl
&nbsp;
Exit_Here:
<span class="TOKEN">On Error GoTo 0</span>
<span class="TOKEN">Exit Sub</span>
&nbsp;
MenuebefehleExtrasDeaktivieren_Error:
MsgBox &quot;Fehler &quot; &amp; Err.Number &amp; vbCrLf &amp; &quot;Beschreibung: &quot; &amp; Err.Description &amp; vbCrLf &amp; _
&quot;Ort: Prozedur MenuebefehleExtrasDeaktivieren&quot; &amp; vbCrLf &amp; &quot;Modul basCommandbars&quot;, vbCritical, &quot;Fehlermeldung&quot;
<span class="TOKEN">Resume</span> Exit_Here
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span>
&nbsp;</pre></div>

Zum Aktivieren dient wiederum das Setzen der Eigenschaft von Enabled auf True:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> MenuebefehleExtrasAktivieren()
<span class="TOKEN">Dim</span> cbControl <span class="TOKEN">As</span> CommandBarControl
<span class="TOKEN">On Error GoTo</span> MenuebefehleExtrasAktivieren_Error
&nbsp;
<span class="TOKEN">For</span> <span class="TOKEN">Each</span> cbControl <span class="TOKEN">In</span> Application.CommandBars(&quot;Tools&quot;).Controls
cbControl.Enabled = <span class="TOKEN">True</span>
<span class="TOKEN">Next</span> cbControl
&nbsp;
Exit_Here:
<span class="TOKEN">On Error GoTo 0</span>
<span class="TOKEN">Exit Sub</span>
&nbsp;
MenuebefehleExtrasAktivieren_Error:
MsgBox &quot;Fehler &quot; &amp; Err.Number &amp; vbCrLf &amp; &quot;Beschreibung: &quot; &amp; Err.Description &amp; vbCrLf &amp; _
&quot;Ort: Prozedur MenuebefehleExtrasAktivieren&quot; &amp; vbCrLf &amp; &quot;Modul basCommandbars&quot;, vbCritical, &quot;Fehlermeldung&quot;
<span class="TOKEN">Resume</span> Exit_Here
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>

Der nächste Schritt sollte dann sein, einen einzelnen Menüpunkt aus der Auswahl herauszunehmen. Hier wurde aus dem Hilfe-Menü der Punkt Info herausgegriffen:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> InfoVerhindern()
<span class="REM">' Zugriff &uuml;ber die ID des Punktes und Schleife</span>
<span class="TOKEN">Dim</span> cbPopup <span class="TOKEN">As</span> CommandBarPopup
<span class="TOKEN">Dim</span> cbControl <span class="TOKEN">As</span> CommandBarControl
&nbsp;
<span class="TOKEN">On Error GoTo</span> InfoVerhindern_Error
&nbsp;
<span class="TOKEN">Set</span> cbPopup = Application.CommandBars.FindControl(Type:=msoControlPopup, ID:=30010)
<span class="TOKEN">For</span> <span class="TOKEN">Each</span> cbControl <span class="TOKEN">In</span> cbPopup.Controls
<span class="TOKEN">If</span> cbControl.ID = 927 <span class="TOKEN">Then</span>
cbControl.Enabled = <span class="TOKEN">False</span>
GoTo Exit_Here
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
<span class="TOKEN">Next</span> cbControl
&nbsp;
Exit_Here:
<span class="TOKEN">On Error GoTo 0</span>
<span class="TOKEN">Set</span> cbPopup = <span class="TOKEN">Nothing</span>
<span class="TOKEN">Exit Sub</span>
&nbsp;
InfoVerhindern_Error:
MsgBox &quot;Fehler &quot; &amp; Err.Number &amp; vbCrLf &amp; &quot;Beschreibung: &quot; &amp; Err.Description &amp; vbCrLf &amp; _
&quot;Ort: Prozedur InfoVerhindern&quot; &amp; vbCrLf &amp; &quot;Modul basCommandbars&quot;, vbCritical, &quot;Fehlermeldung&quot;
<span class="TOKEN">Resume</span> Exit_Here
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>

Der auch hier dazugehörige Code zum Wiedereinsetzen des Menüpunktes:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> InfoFreigeben()
<span class="REM">' Zugriff &uuml;ber die ID des Punktes und Schleife</span>
<span class="TOKEN">Dim</span> cbPopup <span class="TOKEN">As</span> CommandBarPopup
<span class="TOKEN">Dim</span> cbControl <span class="TOKEN">As</span> CommandBarControl
&nbsp;
<span class="TOKEN">On Error GoTo</span> InfoFreigeben_Error
&nbsp;
<span class="TOKEN">Set</span> cbPopup = Application.CommandBars.FindControl(Type:=msoControlPopup, ID:=30010)
<span class="TOKEN">For</span> <span class="TOKEN">Each</span> cbControl <span class="TOKEN">In</span> cbPopup.Controls
<span class="TOKEN">If</span> cbControl.ID = 927 <span class="TOKEN">Then</span>
cbControl.Enabled = <span class="TOKEN">True</span>
GoTo Exit_Here
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
<span class="TOKEN">Next</span> cbControl
&nbsp;
Exit_Here:
<span class="TOKEN">On Error GoTo 0</span>
<span class="TOKEN">Set</span> cbPopup = <span class="TOKEN">Nothing</span>
<span class="TOKEN">Exit Sub</span>
&nbsp;
InfoFreigeben_Error:
MsgBox &quot;Fehler &quot; &amp; Err.Number &amp; vbCrLf &amp; &quot;Beschreibung: &quot; &amp; Err.Description &amp; vbCrLf &amp; _
&quot;Ort: Prozedur InfoFreigeben&quot; &amp; vbCrLf &amp; &quot;Modul basCommandbars&quot;, vbCritical, &quot;Fehlermeldung&quot;
<span class="TOKEN">Resume</span> Exit_Here
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>

War das vorgehen eben über eine Schleife, so kann dies auch direkt über die Angabe der ID erfolgen. Leider hatte ich beim Testen da so einige Probleme (Excel2002 wurde eingesetzt) und konnte nur mit 5-stelligen IDs ohne Laufzeitfehler arbeiten. Daher wird mit dem Menüpunkt Blatt aus dem Menü Format auch ein solcher vorgestellt:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> BlattIDDirekt()
<span class="REM">' Zugriff &uuml;ber die ID des Punktes direkt</span>
<span class="REM">' Funktioniert bei mir nur mit 5-stelligen IDs</span>
<span class="TOKEN">Dim</span> cbPopup <span class="TOKEN">As</span> CommandBarPopup
<span class="TOKEN">On Error GoTo</span> BlattIDDirekt_Error
&nbsp;
<span class="TOKEN">Set</span> cbPopup = Application.CommandBars.FindControl(ID:=30026)
<span class="TOKEN">If</span> <span class="TOKEN">Not</span> cbPopup <span class="TOKEN">Is</span> <span class="TOKEN">Nothing</span> <span class="TOKEN">Then</span> cbPopup.Enabled = <span class="TOKEN">False</span>
&nbsp;
Exit_Here:
<span class="TOKEN">On Error GoTo 0</span>
<span class="TOKEN">Set</span> cbPopup = <span class="TOKEN">Nothing</span>
<span class="TOKEN">Exit Sub</span>
&nbsp;
BlattIDDirekt_Error:
MsgBox &quot;Fehler &quot; &amp; Err.Number &amp; vbCrLf &amp; &quot;Beschreibung: &quot; &amp; Err.Description &amp; vbCrLf &amp; _
&quot;Ort: Prozedur BlattIDDirekt&quot; &amp; vbCrLf &amp; &quot;Modul basCommandbars&quot;, vbCritical, &quot;Fehlermeldung&quot;
<span class="TOKEN">Resume</span> Exit_Here
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>

Und, wie könnte es anders sein, auch hier die Umkehrung der Aktion:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> BlattIDDirektFreigeben()
<span class="REM">' Zugriff &uuml;ber die ID des Punktes direkt</span>
<span class="REM">' Funktioniert bei mir nur mit 5-stelligen IDs</span>
<span class="TOKEN">Dim</span> cbPopup <span class="TOKEN">As</span> CommandBarPopup
<span class="TOKEN">On Error GoTo</span> BlattIDDirektFreigeben_Error
&nbsp;
<span class="TOKEN">Set</span> cbPopup = Application.CommandBars.FindControl(ID:=30026)
<span class="TOKEN">If</span> <span class="TOKEN">Not</span> cbPopup <span class="TOKEN">Is</span> <span class="TOKEN">Nothing</span> <span class="TOKEN">Then</span> cbPopup.Enabled = <span class="TOKEN">True</span>
&nbsp;
Exit_Here:
<span class="TOKEN">On Error GoTo 0</span>
<span class="TOKEN">Set</span> cbPopup = <span class="TOKEN">Nothing</span>
<span class="TOKEN">Exit Sub</span>
&nbsp;
BlattIDDirektFreigeben_Error:
MsgBox &quot;Fehler &quot; &amp; Err.Number &amp; vbCrLf &amp; &quot;Beschreibung: &quot; &amp; Err.Description &amp; vbCrLf &amp; _
&quot;Ort: Prozedur BlattIDDirektFreigeben&quot; &amp; vbCrLf &amp; &quot;Modul basCommandbars&quot;, vbCritical, &quot;Fehlermeldung&quot;
<span class="TOKEN">Resume</span> Exit_Here
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>
Code eingefügt mit dem MOF Code Converter (http://www.ms-office-forum.net/forum/codeconverter.php)</font>

jinx
08.11.2001, 21:22
<font size="2" face="Century Gothic">Moin,

in diesem Abschnitt soll es um die Erweiterung eines Menüpunktes gehen - das Beispiel erstellt den neuen Menüpunkt <i>Markieren Zellen mit ,,,</i> am unteren Ende des Bearbeiten-Menüs mit einigen weiteren Unterpunkten. Die aufgerufenen Makros sind darunter angegeben.

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> KaskadenMen&uuml;Erstellen()
<span class="REM">' Bernd Held, Excel-VBA-Programmierung, S. 557ff</span>
<span class="REM">' Men&uuml;punkte bestehen nur f&uuml;r die Dauer der Sitzung und</span>
<span class="REM">' werden bei Beendigung der Anwendung gel&ouml;scht</span>
<span class="TOKEN">Dim</span> Kaskade <span class="TOKEN">As</span> CommandBarPopup
<span class="TOKEN">Dim</span> UnterMen&uuml; <span class="TOKEN">As</span> CommandBarPopup
<span class="TOKEN">Dim</span> UKaskade <span class="TOKEN">As</span> CommandBarControl
<span class="TOKEN">Dim</span> i <span class="TOKEN">As</span> <span class="TOKEN">Integer</span>
&nbsp;
<span class="TOKEN">On Error GoTo</span> KaskadenMen&uuml;Erstellen_Error
&nbsp;
i = CommandBars(1).Controls(&quot;Bearbeiten&quot;).Controls.Count
&nbsp;
<span class="TOKEN">Set</span> Kaskade = CommandBars(1).Controls(&quot;Bearbeiten&quot;).Controls.Add _
(Type:=msoControlPopup, before:=i, Temporary:=True)
<span class="TOKEN">With</span> Kaskade
.Caption = &quot;&amp;Markieren Zellen mit ...&quot;
.BeginGroup = <span class="TOKEN">True</span>
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
<span class="TOKEN">With</span> Kaskade.Controls.Add(Type:=msoControlButton, Temporary:=True)
.Caption = &quot;&amp;Formeln&quot;
.OnAction = &quot;FormelZellenMarkieren&quot;
.Style = msoButtonIconAndCaption
.FaceId = 373
.Enabled = <span class="TOKEN">True</span>
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
<span class="TOKEN">With</span> Kaskade.Controls.Add(Type:=msoControlButton, Temporary:=True)
.Caption = &quot;&amp;Kommentaren&quot;
.OnAction = &quot;KommentarZellenMarkieren&quot;
.FaceId = 1589
.Style = msoButtonIconAndCaption
.Enabled = <span class="TOKEN">True</span>
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
&nbsp;
<span class="TOKEN">Set</span> UnterMen&uuml; = Kaskade.Controls.Add(Type:=msoControlPopup, Temporary:=True)
<span class="TOKEN">With</span> UnterMen&uuml;
.Caption = &quot;&amp;G&uuml;tigkeitsregeln&quot;
.BeginGroup = <span class="TOKEN">True</span>
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
&nbsp;
<span class="TOKEN">Set</span> UKaskade = UnterMen&uuml;.Controls.Add(Type:=msoControlButton)
<span class="TOKEN">With</span> UKaskade
.Caption = &quot;&amp;Alle G&uuml;ltigkeitsregeln&quot;
.OnAction = &quot;G&uuml;ltigkeitsZellenMarkieren&quot;
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
&nbsp;
<span class="TOKEN">Set</span> UKaskade = UnterMen&uuml;.Controls.Add(Type:=msoControlButton)
<span class="TOKEN">With</span> UKaskade
.Caption = &quot;gleich&amp;e G&uuml;ltigkeitsregeln&quot;
.OnAction = &quot;GleicheG&uuml;ltigkeitsZellenMarkieren&quot;
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
&nbsp;
<span class="TOKEN">With</span> Kaskade.Controls.Add(Type:=msoControlButton, Temporary:=True)
.Caption = &quot;&amp;bedingten Formaten&quot;
.OnAction = &quot;BedingtFormatierteZellenMarkieren&quot;
.Style = msoButtonIconAndCaption
.Enabled = <span class="TOKEN">True</span>
.BeginGroup = <span class="TOKEN">True</span>
.FaceId = 962
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
&nbsp;
Exit_Here:
<span class="TOKEN">Set</span> Kaskade = <span class="TOKEN">Nothing</span>
<span class="TOKEN">Set</span> UKaskade = <span class="TOKEN">Nothing</span>
<span class="TOKEN">Set</span> UnterMen&uuml; = <span class="TOKEN">Nothing</span>
<span class="REM">' Application.CommandBars(1).Controls(&quot;Bearbeiten&quot;).Execute</span>
<span class="TOKEN">On Error GoTo 0</span>
<span class="TOKEN">Exit Sub</span>
&nbsp;
KaskadenMen&uuml;Erstellen_Error:
MsgBox &quot;Fehler &quot; &amp; Err.Number &amp; vbCrLf &amp; &quot;Beschreibung: &quot; &amp; Err.Description &amp; vbCrLf &amp; _
&quot;Ort: Prozedur KaskadenMen&uuml;Erstellen&quot; &amp; vbCrLf &amp; &quot;Modul basCascading&quot;, vbCritical, &quot;Fehlermeldung&quot;
<span class="TOKEN">Resume</span> Exit_Here
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> FormelZellenMarkieren()
<span class="TOKEN">On Error GoTo</span> Fehler
Selection.SpecialCells(xlCellTypeFormulas).Select
<span class="TOKEN">Exit Sub</span>
Fehler:
MsgBox &quot;Es gibt auf diesem Blatt keine Zellen mit Formeln!&quot;
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr>&nbsp;
<span class="TOKEN">Sub</span> KommentarZellenMarkieren()
<span class="TOKEN">On Error GoTo</span> Fehler
Selection.SpecialCells(xlCellTypeComments).Select
<span class="TOKEN">Exit Sub</span>
Fehler:
MsgBox &quot;Es gibt auf diesem Blatt keine Zellen mit Kommentaren!&quot;
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr>&nbsp;
<span class="TOKEN">Sub</span> G&uuml;ltigkeitsZellenMarkieren()
<span class="TOKEN">On Error GoTo</span> Fehler
Selection.SpecialCells(xlCellTypeAllValidation).Select
<span class="TOKEN">Exit Sub</span>
Fehler:
MsgBox &quot;Es gibt auf diesem Blatt keine Zellen mit G&uuml;ltigkeitsregeln!&quot;
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr>&nbsp;
<span class="TOKEN">Sub</span> GleicheG&uuml;ltigkeitsZellenMarkieren()
<span class="TOKEN">On Error GoTo</span> Fehler
Selection.SpecialCells(xlCellTypeSameValidation).Select
<span class="TOKEN">Exit Sub</span>
Fehler:
MsgBox &quot;Es gibt auf diesem Blatt keine weiteren Zellen mit denselben G&uuml;ltigkeitsregeln!&quot;
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr>&nbsp;
<span class="TOKEN">Sub</span> BedingtFormatierteZellenMarkieren()
<span class="TOKEN">On Error GoTo</span> Fehler
Selection.SpecialCells(xlCellTypeAllFormatConditions).Select
<span class="TOKEN">Exit Sub</span>
Fehler:
MsgBox &quot;Es gibt auf diesem Blatt keine Zellen mit bedingten Formaten!&quot;
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>
Code eingefügt mit dem MOF Code Converter (http://www.ms-office-forum.net/forum/codeconverter.php)</font>

jinx
13.11.2001, 06:19
<font size="2" face="Century Gothic">Moin,

dann wollen wir uns mal dem Erstellen eines eigenen Menüs widmen ;)

Zuerst wird ein eigener Menüpunkt angelegt, der auch nur einen Unterpunkt beherbergt:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> NewMenu()
<span class="REM">' Quelle: Hans W. Herber 040398</span>
<span class="REM">' Wie kann ich der aktiven Men&uuml;leiste ein neues Men&uuml; mit einem Men&uuml;punkt hinzuf&uuml;gen?</span>
<span class="REM">' Neuer Punkt am Ende der Men&uuml;leiste wird eingef&uuml;gt, dieser Men&uuml;pnukt verf&uuml;gt &uuml;ber</span>
<span class="REM">' keine Funktionalit&auml;t, die &uuml;ber .OnAction = NameDerProzedur zugewiesen werden kann</span>
<span class="TOKEN">Dim</span> oBar <span class="TOKEN">As</span> CommandBar
<span class="TOKEN">Dim</span> oPopUp <span class="TOKEN">As</span> CommandBarPopup
<span class="TOKEN">Dim</span> oBtn <span class="TOKEN">As</span> CommandBarControl
<span class="TOKEN">Set</span> oBar = Application.CommandBars(&quot;Worksheet Menu Bar&quot;)
<span class="TOKEN">Call</span> Zurueck
<span class="TOKEN">Set</span> oPopUp = oBar.Controls.Add( _
Type:=msoControlPopup, _
Temporary:=False)
oPopUp.Caption = &quot;MeinMen&uuml;&quot;
<span class="TOKEN">Set</span> oBtn = oPopUp.Controls.Add
<span class="TOKEN">With</span> oBtn
.Caption = &quot;Import&quot;
.TooltipText = &quot;Import&quot;
.Style = msoButtonCaption
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span>
&nbsp;
<span class="TOKEN">Sub</span> Zurueck()
<span class="TOKEN">On</span> <span class="TOKEN">Error</span> <span class="TOKEN">Resume</span> <span class="TOKEN">Next</span>
Application.CommandBars( _
&quot;Worksheet Menu Bar&quot;).Controls(&quot;MeinMen&uuml;&quot;).Delete
<span class="TOKEN">On Error GoTo 0</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>

Ein wenig komfortabler geht es auf die folgende Art, wobei das Menü beim Öffnen der Mappe angelegt und entweder über die Menüauswahl (die den nächsten genannten Punkt aufruft) oder beim Schließen direkt aufruft:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="REM">' DieseArbeitsmappe</span>
<span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Private Sub</span> Workbook_BeforeClose(Cancel <span class="TOKEN">As</span> <span class="TOKEN">Boolean</span>)
<span class="TOKEN">With</span> Application.CommandBars(&quot;Worksheet Menu Bar&quot;)
<span class="TOKEN">On</span> <span class="TOKEN">Error</span> <span class="TOKEN">Resume</span> <span class="TOKEN">Next</span>
.Controls(&quot;&amp;Monate&quot;).Delete
<span class="TOKEN">On Error GoTo 0</span>
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr>&nbsp;
<span class="TOKEN">Private Sub</span> Workbook_Open()
<span class="REM">' Quelle: Hans W. Herber 171302</span>
<span class="REM">' Die Werte aus Spalte A aus Monatsbl&auml;ttern sollen in das Tabellenblatt &quot;Gesamt&quot;</span>
<span class="REM">' in die entsprechende Monatsspalte eingetragen werden.</span>
<span class="TOKEN">Dim</span> objPopUp <span class="TOKEN">As</span> CommandBarPopup
<span class="TOKEN">Dim</span> objBtn <span class="TOKEN">As</span> CommandBarButton
<span class="TOKEN">With</span> Application.CommandBars(&quot;Worksheet Menu Bar&quot;)
<span class="TOKEN">On</span> <span class="TOKEN">Error</span> <span class="TOKEN">Resume</span> <span class="TOKEN">Next</span>
.Controls(&quot;&amp;Monate&quot;).Delete
<span class="TOKEN">On Error GoTo 0</span>
<span class="TOKEN">Set</span> objPopUp = .Controls.Add( _
Type:=msoControlPopup, _
before:=.Controls.Count, _
temporary:=True)
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
objPopUp.Caption = &quot;&amp;Monate&quot;
<span class="TOKEN">Set</span> objBtn = objPopUp.Controls.Add
<span class="TOKEN">With</span> objBtn
.Caption = &quot;&amp;In Sammelblatt&quot;
.OnAction = &quot;InSammelblatt&quot;
.Style = msoButtonCaption
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
<span class="TOKEN">Set</span> objBtn = objPopUp.Controls.Add
<span class="TOKEN">With</span> objBtn
.Caption = &quot;&amp;Beenden&quot;
.OnAction = &quot;EndeMonate&quot;
.Style = msoButtonCaption
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr>&nbsp;
<span class="REM">' allgemeines Modul, z.B. Modul1 oder basClassic</span>
<span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> MonatAnlegen()
<span class="TOKEN">Dim</span> iMonth <span class="TOKEN">As</span> <span class="TOKEN">Integer</span>
<span class="TOKEN">For</span> iMonth = 1 <span class="TOKEN">To</span> 12
Worksheets.Add after:=Worksheets(iMonth)
ActiveSheet.Name = Format(DateSerial(1, iMonth, 1), &quot;mmmm&quot;)
<span class="TOKEN">Next</span> iMonth
Worksheets(1).Select
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr>&nbsp;
<span class="TOKEN">Sub</span> EndeMonate()
ThisWorkbook.Close
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr>&nbsp;
<span class="TOKEN">Sub</span> InSammelblatt()
<span class="TOKEN">Dim</span> rng <span class="TOKEN">As</span> Range
<span class="TOKEN">Dim</span> iCol <span class="TOKEN">As</span> <span class="TOKEN">Integer</span>
<span class="TOKEN">If</span> ActiveSheet.Index &gt; 12 <span class="TOKEN">Then</span>
Beep
MsgBox &quot;Sie m&uuml;ssen sich in einem Monatsblatt befinden!&quot;
<span class="TOKEN">Exit Sub</span>
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
<span class="TOKEN">Set</span> rng = Range(&quot;A2:A&quot; &amp; WorksheetFunction.CountA(Columns(1)))
<span class="TOKEN">With</span> Worksheets(&quot;Gesamt&quot;)
iCol = WorksheetFunction.Match(ActiveSheet.Name, .Rows(1), 0)
.Range(.Cells(2, iCol), .Cells(Rows.Count, iCol)).ClearContents
.Range(.Cells(2, iCol), .Cells(rng.Rows.Count + 1, iCol)).Value = rng.Value
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div></font>

jinx
18.11.2001, 16:02
<font size="2" face="Century Gothic">Moin,

in diesem Teilabschnitt soll die Kenntlichmachung des Zustandes durch die Verwendung von Häkchen dargestellt werden. Dazu wird ein eigener Menüpunkt angelegt (Analyse), der vor der Hilfe eingestellt werden soll.

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> AnalyseMen&uuml;Einf&uuml;gen()
<span class="REM">' Bernd Held, Excel-VBA-Programmierung, S. 561 - 566</span>
<span class="TOKEN">Dim</span> i <span class="TOKEN">As</span> <span class="TOKEN">Integer</span>
<span class="TOKEN">Dim</span> i_Hilfe <span class="TOKEN">As</span> <span class="TOKEN">Integer</span>
<span class="TOKEN">Dim</span> Men&uuml;Neu <span class="TOKEN">As</span> CommandBarControl
<span class="TOKEN">Dim</span> Mb <span class="TOKEN">As</span> CommandBarControl
&nbsp;
<span class="TOKEN">On Error GoTo</span> AnalyseMen&uuml;Einf&uuml;gen_Error
&nbsp;
i = Application.CommandBars(1).Controls.Count
i_Hilfe = Application.CommandBars(1).Controls(i).Index
<span class="TOKEN">Set</span> Men&uuml;Neu = Application.CommandBars(1). _
Controls.Add(Type:=msoControlPopup, before:=i_Hilfe)
Men&uuml;Neu.Caption = &quot;Anal&amp;yse&quot;
&nbsp;
<span class="TOKEN">Set</span> Mb = Men&uuml;Neu.Controls.Add(Type:=msoControlButton)
<span class="TOKEN">With</span> Mb
.Caption = &quot;Zellen mit G&uuml;ltigkeitsregeln&quot;
.Style = msoButtonCaption
.OnAction = &quot;Pr&uuml;fenG&uuml;ltigkeit&quot;
.State = msoButtonUp
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
&nbsp;
<span class="TOKEN">Set</span> Mb = Men&uuml;Neu.Controls.Add(Type:=msoControlButton)
<span class="TOKEN">With</span> Mb
.Caption = &quot;Zellen mit bedingten Formaten&quot;
.Style = msoButtonCaption
.OnAction = &quot;Pr&uuml;fenBedFormatierung&quot;
.State = msoButtonUp
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
&nbsp;
<span class="TOKEN">Set</span> Mb = Men&uuml;Neu.Controls.Add(Type:=msoControlButton)
<span class="TOKEN">With</span> Mb
.Caption = &quot;Zeilen ausgeblendet&quot;
.Style = msoButtonIconAndCaption
.OnAction = &quot;Pr&uuml;fenZeilen &quot;
.State = msoButtonUp
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
&nbsp;
<span class="TOKEN">Set</span> Mb = Men&uuml;Neu.Controls.Add(Type:=msoControlButton)
<span class="TOKEN">With</span> Mb
.Caption = &quot;Spalten ausgeblendet&quot;
.Style = msoButtonIconAndCaption
.OnAction = &quot;Pr&uuml;fenSpalten&quot;
.State = msoButtonUp
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
&nbsp;
<span class="TOKEN">Set</span> Mb = Men&uuml;Neu.Controls.Add(Type:=msoControlButton)
<span class="TOKEN">With</span> Mb
.Caption = &quot;Tabelle gesch&uuml;tzt&quot;
.Style = msoButtonIconAndCaption
.OnAction = &quot;Pr&uuml;fenSchutz &quot;
.State = msoButtonUp
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
&nbsp;
<span class="TOKEN">Set</span> Mb = Men&uuml;Neu.Controls.Add(Type:=msoControlButton)
<span class="TOKEN">With</span> Mb
.Caption = &quot;Hyperlinks&quot;
.Style = msoButtonIconAndCaption
.OnAction = &quot;Pr&uuml;fenHyperlinks&quot;
.State = msoButtonUp
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
&nbsp;
Exit_Here:
<span class="TOKEN">Set</span> Mb = <span class="TOKEN">Nothing</span>
<span class="TOKEN">On Error GoTo 0</span>
<span class="TOKEN">Exit Sub</span>
&nbsp;
AnalyseMen&uuml;Einf&uuml;gen_Error:
MsgBox &quot;Fehler &quot; &amp; Err.Number &amp; vbCrLf &amp; &quot;Beschreibung: &quot; &amp; Err.Description &amp; vbCrLf &amp; _
&quot;Ort: Prozedur AnalyseMen&uuml;Einf&uuml;gen&quot; &amp; vbCrLf &amp; &quot;Modul basMenuButton&quot;, vbCritical, &quot;Fehlermeldung&quot;
<span class="TOKEN">Resume</span> Exit_Here
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>

Die im Menü angesprochenen Makros sehen wie folgt aus:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> Pr&uuml;fenG&uuml;ltigkeit()
<span class="TOKEN">Dim</span> Mb <span class="TOKEN">As</span> CommandBarControl
<span class="TOKEN">Dim</span> Men&uuml; <span class="TOKEN">As</span> CommandBarControl
<span class="TOKEN">Dim</span> i <span class="TOKEN">As</span> <span class="TOKEN">Integer</span>
&nbsp;
<span class="TOKEN">Set</span> Men&uuml; = CommandBars(1).Controls(&quot;Analyse&quot;)
<span class="TOKEN">Set</span> Mb = Men&uuml;.Controls(1)
&nbsp;
i = 0
i = ActiveCell.SpecialCells(xlCellTypeAllValidation).Count
<span class="TOKEN">If</span> i &gt; 1 <span class="TOKEN">Then</span>
ActiveCell.SpecialCells(xlCellTypeAllValidation).Select
Mb.State = msoButtonDown
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
<span class="TOKEN">Set</span> Mb = <span class="TOKEN">Nothing</span>
<span class="TOKEN">Set</span> Men&uuml; = <span class="TOKEN">Nothing</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr>&nbsp;
<span class="TOKEN">Sub</span> Pr&uuml;fenBedFormatierung()
<span class="TOKEN">Dim</span> Mb <span class="TOKEN">As</span> CommandBarControl
<span class="TOKEN">Dim</span> Men&uuml; <span class="TOKEN">As</span> CommandBarControl
<span class="TOKEN">Dim</span> i <span class="TOKEN">As</span> <span class="TOKEN">Integer</span>
&nbsp;
<span class="TOKEN">Set</span> Men&uuml; = CommandBars(1).Controls(&quot;Analyse&quot;)
<span class="TOKEN">Set</span> Mb = Men&uuml;.Controls(2)
&nbsp;
i = 0
i = ActiveCell.SpecialCells(xlCellTypeAllFormatConditions).Count
<span class="TOKEN">If</span> i &gt; 1 <span class="TOKEN">Then</span>
ActiveCell.SpecialCells(xlCellTypeAllFormatConditions).Select
Mb.State = msoButtonDown
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
<span class="TOKEN">Set</span> Mb = <span class="TOKEN">Nothing</span>
<span class="TOKEN">Set</span> Men&uuml; = <span class="TOKEN">Nothing</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr>&nbsp;
<span class="TOKEN">Sub</span> Pr&uuml;fenZeilen()
<span class="TOKEN">Dim</span> Mb <span class="TOKEN">As</span> CommandBarControl
<span class="TOKEN">Dim</span> Men&uuml; <span class="TOKEN">As</span> CommandBarControl
<span class="TOKEN">Dim</span> Zeile <span class="TOKEN">As</span> Object
&nbsp;
<span class="TOKEN">Set</span> Men&uuml; = CommandBars(1).Controls(&quot;Analyse&quot;)
<span class="TOKEN">Set</span> Mb = Men&uuml;.Controls(3)
<span class="TOKEN">For</span> <span class="TOKEN">Each</span> Zeile <span class="TOKEN">In</span> ActiveSheet.UsedRange.Rows
<span class="TOKEN">If</span> Zeile.Hidden = <span class="TOKEN">True</span> <span class="TOKEN">Then</span> Mb.State = msoButtonDown: <span class="TOKEN">Exit Sub</span>
<span class="TOKEN">Next</span> Zeile
<span class="TOKEN">Set</span> Mb = <span class="TOKEN">Nothing</span>
<span class="TOKEN">Set</span> Men&uuml; = <span class="TOKEN">Nothing</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr>&nbsp;
<span class="TOKEN">Sub</span> Pr&uuml;fenSpalten()
<span class="TOKEN">Dim</span> Mb <span class="TOKEN">As</span> CommandBarControl
<span class="TOKEN">Dim</span> Men&uuml; <span class="TOKEN">As</span> CommandBarControl
<span class="TOKEN">Dim</span> Spalte <span class="TOKEN">As</span> Object
&nbsp;
<span class="TOKEN">Set</span> Men&uuml; = CommandBars(1).Controls(&quot;Analyse&quot;)
<span class="TOKEN">Set</span> Mb = Men&uuml;.Controls(4)
&nbsp;
<span class="TOKEN">For</span> <span class="TOKEN">Each</span> Spalte <span class="TOKEN">In</span> ActiveSheet.UsedRange.Columns
<span class="TOKEN">If</span> Spalte.Hidden = <span class="TOKEN">True</span> <span class="TOKEN">Then</span>
Mb.State = msoButtonDown
<span class="TOKEN">Exit Sub</span>
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
<span class="TOKEN">Next</span> Spalte
<span class="TOKEN">Set</span> Mb = <span class="TOKEN">Nothing</span>
<span class="TOKEN">Set</span> Men&uuml; = <span class="TOKEN">Nothing</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr>&nbsp;
<span class="TOKEN">Sub</span> Pr&uuml;fenSchutz()
<span class="TOKEN">Dim</span> Mb <span class="TOKEN">As</span> CommandBarControl
<span class="TOKEN">Dim</span> Men&uuml; <span class="TOKEN">As</span> CommandBarControl
&nbsp;
<span class="TOKEN">Set</span> Men&uuml; = CommandBars(1).Controls(&quot;Analyse&quot;)
<span class="TOKEN">Set</span> Mb = Men&uuml;.Controls(5)
&nbsp;
<span class="TOKEN">If</span> ActiveSheet.ProtectContents = <span class="TOKEN">True</span> <span class="TOKEN">Then</span> Mb.State = msoButtonDown
<span class="TOKEN">Set</span> Mb = <span class="TOKEN">Nothing</span>
<span class="TOKEN">Set</span> Men&uuml; = <span class="TOKEN">Nothing</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr>&nbsp;
<span class="TOKEN">Sub</span> Pr&uuml;fenHyperlinks()
<span class="TOKEN">Dim</span> i <span class="TOKEN">As</span> <span class="TOKEN">Integer</span>
<span class="TOKEN">Dim</span> Mb <span class="TOKEN">As</span> CommandBarControl
<span class="TOKEN">Dim</span> Men&uuml; <span class="TOKEN">As</span> CommandBarControl
&nbsp;
<span class="TOKEN">Set</span> Men&uuml; = CommandBars(1).Controls(&quot;Analyse&quot;)
<span class="TOKEN">Set</span> Mb = Men&uuml;.Controls(6)
<span class="TOKEN">If</span> ActiveSheet.Hyperlinks.Count &gt; 0 <span class="TOKEN">Then</span> Mb.State = msoButtonDown
Men&uuml;.Execute
<span class="TOKEN">Set</span> Mb = <span class="TOKEN">Nothing</span>
<span class="TOKEN">Set</span> Men&uuml; = <span class="TOKEN">Nothing</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>

Zum Zurücksetzen aller Häkchen kann das folgende Makro genutzt werden:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> Zur&uuml;cksetzen()
<span class="TOKEN">Dim</span> Mb <span class="TOKEN">As</span> CommandBarControl
&nbsp;
<span class="TOKEN">Set</span> Mb = CommandBars(1).Controls(&quot;Analyse&quot;)
<span class="TOKEN">With</span> Mb
.Controls(1).State = msoButtonUp
.Controls(2).State = msoButtonUp
.Controls(3).State = msoButtonUp
.Controls(4).State = msoButtonUp
.Controls(5).State = msoButtonUp
.Controls(6).State = msoButtonUp
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
<span class="TOKEN">Set</span> Mb = <span class="TOKEN">Nothing</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>
Code eingefügt mit dem MOF Code Converter (http://www.ms-office-forum.net/forum/codeconverter.php)</font>

jinx
18.11.2001, 16:06
<font size="2" face="Century Gothic">Moin,

bisher wurden die Menüs durch die direkte Eingabe von allen Punkten erzeugt. Dies heißt dann aber auch, dass ein Umstellen/Umschreiben von Menüpunkten immer mit allen Angaben erfolgen muss. Dies geht auch einfacher, wenn man die Angaben zu dem Menü in tabellarischer Form ablegt und dann abarbeitet.

Dazu mag die folgende Tabelle als Grundlage dienen (Beispiel ist aus der Gold Bible 2000 von John Walkenbach):<table><tr style="vertical-align:top; text-align:center; "><tr><td>MenuSheet</td></tr><tr><td><table border=1 cellspacing=0 cellpadding=0 style="font-family:Arial,Arial; font-size:10pt; padding-left:2pt; padding-right:2pt; "> <style type = "text/css"> th {font-weight:normal} </style> <colgroup><col width=30 style="font-weight:bold; "><col width=52.999998675 ><col width=160.999995975 ><col width=117.99999705 ><col width=64.999998375 ><col width=66.999998325 ></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td>&nbsp;</td><td>A</td><td>B</td><td>C</td><td>D</td><td>E</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td style="background-color:#ffff00; font-weight:bold; ">Level</td><td style="background-color:#ffff00; font-weight:bold; ">Caption</td><td style="background-color:#ffff00; text-align:center; font-weight:bold; ">Position/Macro</td><td style="background-color:#ffff00; font-weight:bold; ">Divider</td><td style="background-color:#ffff00; font-weight:bold; ">FaceID</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td style="text-align:right; font-weight:bold; ">1</td><td style="font-weight:bold; ">&MyMenu</td><td style="text-align:center; font-weight:bold; ">10</td><td style="font-weight:bold; ">&nbsp;</td><td style="font-weight:bold; ">&nbsp;</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td style="text-align:right; ">2</td><td style="">Wi&zards</td><td style="text-align:center; ">&nbsp;</td><td style="">&nbsp;</td><td style="">&nbsp;</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td style="text-align:right; ">3</td><td style="">Wizard Number &1</td><td style="text-align:center; ">DummyMacro</td><td style="">&nbsp;</td><td style="text-align:right; ">128</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td style="text-align:right; ">3</td><td style="">Wizard Number &2</td><td style="text-align:center; ">DummyMacro</td><td style="">&nbsp;</td><td style="text-align:right; ">79</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td style="text-align:right; ">3</td><td style="">Wizard Number &3</td><td style="text-align:center; ">DummyMacro</td><td style="text-align:right; ">WAHR</td><td style="text-align:right; ">51</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td style="text-align:right; ">2</td><td style="">&Tools</td><td style="text-align:center; ">&nbsp;</td><td style="">&nbsp;</td><td style="">&nbsp;</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >8</td><td style="text-align:right; ">3</td><td style="">Tools Number &1</td><td style="text-align:center; ">DummyMacro</td><td style="">&nbsp;</td><td style="text-align:right; ">167</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >9</td><td style="text-align:right; ">3</td><td style="">Tools Number &2</td><td style="text-align:center; ">DummyMacro</td><td style="">&nbsp;</td><td style="text-align:right; ">5</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >10</td><td style="text-align:right; ">2</td><td style="">&Printing</td><td style="text-align:center; ">&nbsp;</td><td style="">&nbsp;</td><td style="">&nbsp;</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >11</td><td style="text-align:right; ">3</td><td style="">Printing Number &1</td><td style="text-align:center; ">DummyMacro</td><td style="">&nbsp;</td><td style="text-align:right; ">190</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >12</td><td style="text-align:right; ">3</td><td style="">Printing Number &2</td><td style="text-align:center; ">DummyMacro</td><td style="">&nbsp;</td><td style="text-align:right; ">53</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >13</td><td style="text-align:right; ">3</td><td style="">Printing Number &3</td><td style="text-align:center; ">DummyMacro</td><td style="text-align:right; ">WAHR</td><td style="text-align:right; ">82</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >14</td><td style="text-align:right; ">2</td><td style="">&Charts</td><td style="text-align:center; ">&nbsp;</td><td style="">&nbsp;</td><td style="">&nbsp;</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >15</td><td style="text-align:right; ">3</td><td style="">Charts Number &1</td><td style="text-align:center; ">DummyMacro</td><td style="">&nbsp;</td><td style="text-align:right; ">192</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >16</td><td style="text-align:right; ">3</td><td style="">Charts Number &1</td><td style="text-align:center; ">DummyMacro</td><td style="">&nbsp;</td><td style="text-align:right; ">250</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >17</td><td style="text-align:right; ">2</td><td style="">&Minimize</td><td style="text-align:center; ">DummyMacro</td><td style="text-align:right; ">WAHR</td><td style="text-align:right; ">311</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >18</td><td style="text-align:right; ">2</td><td style="">Ma&ximize</td><td style="text-align:center; ">DummyMacro</td><td style="">&nbsp;</td><td style="text-align:right; ">394</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >19</td><td style="text-align:right; ">2</td><td style="">&Help</td><td style="text-align:center; ">&nbsp;</td><td style="text-align:right; ">WAHR</td><td style="">&nbsp;</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >20</td><td style="text-align:right; ">3</td><td style="">&Help Contents</td><td style="text-align:center; ">DummyMacro</td><td style="">&nbsp;</td><td style="text-align:right; ">228</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >21</td><td style="text-align:right; ">3</td><td style="">&More Help</td><td style="text-align:center; ">DummyMacro</td><td style="">&nbsp;</td><td style="text-align:right; ">81</td></tr><tr height=17 ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >22</td><td style="text-align:right; ">3</td><td style="">&About</td><td style="text-align:center; ">DummyMacro</td><td style="text-align:right; ">WAHR</td><td style="text-align:right; ">316</td></tr></table></td></tr><tr><td>&nbsp;</td></tr></tr></table>Spalte A <i>Level</i> legt fest, um welche Stufe des Menüs es sich handelt: 1 entspricht dem Punkt in der Menüleiste, 2 einem Menüpunkt und 3 einem Untermenüpunkt.
Spalte B <i>Caption</i> legt den Namen des Menüs fest.
Spalte C <i>Position/Macro</i> gibt für Level 1 die Position an, an der sich das Menü befinden soll; für Level 2 oder 3 wird hier der Name des auszuführenden Makros bei Wahl angegeben. Wenn ein Level 2 Menü mehrere Unterpunkte hat, muss dort kein Makro angegeben werden.
Spalte D <i>Divider</i> legt fest, ob ein Trennstrich zwischen den Menüpunkten eingefügt werden soll oder nicht.
Spalte E <i>FaceID</i> wurde durch die Erzeugung einer Zufallszahl gespeist. Dort wird die Nummer des Symbols angegeben, welches vor dem Menüpunkt eingesetzt werden soll.

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="REM">' Code in DieseArbeitsmappe</span>
<span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Private Sub</span> Workbook_Open()
<span class="TOKEN">Call</span> CreateMenu
MsgBox &quot;A new menu (MyMenu) was created.&quot;, vbInformation
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr>&nbsp;
<span class="TOKEN">Private Sub</span> Workbook_BeforeClose(Cancel <span class="TOKEN">As</span> <span class="TOKEN">Boolean</span>)
<span class="TOKEN">Call</span> DeleteMenu
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="REM">' Allgemeines Modul</span>
<span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Sub</span> CreateMenu()
<span class="REM">' John Walkenbach: Microsoft Excel 2000 Bible Gold Edition, S. 1214 - 1217</span>
<span class="REM">' This sub should be executed when the workbook is opened.</span>
<span class="REM">' NOTE: There is no error handling in this subroutine</span>
<span class="REM">'/// Diese Prozedur sollte ausgef&uuml;hrt werden, wenn die Mappe ge&ouml;ffnet wird</span>
<span class="REM">'/// WICHTIG: es gibt keine Fehlerbehandlung in diesem Vorgehen</span>
&nbsp;
<span class="TOKEN">Dim</span> MenuSheet <span class="TOKEN">As</span> Worksheet
<span class="TOKEN">Dim</span> MenuObject <span class="TOKEN">As</span> CommandBarPopup
&nbsp;
<span class="TOKEN">Dim</span> MenuItem <span class="TOKEN">As</span> Object
<span class="TOKEN">Dim</span> SubMenuItem <span class="TOKEN">As</span> CommandBarButton
<span class="TOKEN">Dim</span> iRow <span class="TOKEN">As</span> <span class="TOKEN">Integer</span>
<span class="TOKEN">Dim</span> MenuLevel, NextLevel, PositionOrMacro, Caption, Divider, FaceId
&nbsp;
<span class="REM">''''''''''''''''''''''''''''''''''''''''''''''''''</span>
<span class="REM">' Location for menu data</span>
<span class="REM">'/// Festlegen der Datentabelle</span>
<span class="TOKEN">Set</span> MenuSheet = ThisWorkbook.Sheets(&quot;MenuSheet&quot;)
<span class="REM">''''''''''''''''''''''''''''''''''''''''''''''''''</span>
&nbsp;
<span class="REM">' Make sure the menus aren't duplicated</span>
<span class="REM">'/// Sicherstellen, dass es nur ein Men&uuml; gibt</span>
<span class="TOKEN">Call</span> DeleteMenu
&nbsp;
<span class="REM">' Initialize the row counter</span>
<span class="REM">'/// Belegen des Zeilenz&auml;hlers</span>
iRow = 2
&nbsp;
<span class="REM">' Add the menus, menu items and submenu items using</span>
<span class="REM">' data stored on MenuSheet</span>
<span class="REM">'/// Hinzuf&uuml;gen des Men&uuml;s, der Men&uuml;- und Untermen&uuml;punkte</span>
<span class="REM">'/// auf der Basis der Daten aus der Datentabelle MenuSheet</span>
&nbsp;
<span class="TOKEN">Do</span> <span class="TOKEN">Until</span> IsEmpty(MenuSheet.Cells(iRow, 1))
<span class="TOKEN">With</span> MenuSheet
MenuLevel = .Cells(iRow, 1)
Caption = .Cells(iRow, 2)
PositionOrMacro = .Cells(iRow, 3)
Divider = .Cells(iRow, 4)
FaceId = .Cells(iRow, 5)
NextLevel = .Cells(iRow + 1, 1)
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
&nbsp;
Select Case MenuLevel
Case 1 <span class="REM">' A Menu</span>
<span class="REM">' Add the top-level menu to the Worksheet CommandBar</span>
<span class="REM">'/// Hinzuf&uuml;gen des Men&uuml;punktes in die Men&uuml;leiste</span>
<span class="TOKEN">Set</span> MenuObject = Application.CommandBars(1). _
Controls.Add(Type:=msoControlPopup, _
Before:=PositionOrMacro, _
Temporary:=True)
MenuObject.Caption = Caption
&nbsp;
Case 2 <span class="REM">' A Menu Item /// Ein Men&uuml;punkt</span>
<span class="TOKEN">If</span> NextLevel = 3 <span class="TOKEN">Then</span>
<span class="TOKEN">Set</span> MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup)
<span class="TOKEN">Else</span>
<span class="TOKEN">Set</span> MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
MenuItem.OnAction = PositionOrMacro
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
MenuItem.Caption = Caption
<span class="TOKEN">If</span> FaceId &lt;&gt; &quot;&quot; <span class="TOKEN">Then</span> MenuItem.FaceId = FaceId
<span class="TOKEN">If</span> Divider <span class="TOKEN">Then</span> MenuItem.BeginGroup = <span class="TOKEN">True</span>
&nbsp;
Case 3 <span class="REM">' A SubMenu Item /// Ein Untermen&uuml;punkt</span>
<span class="TOKEN">Set</span> SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = Caption
SubMenuItem.OnAction = PositionOrMacro
<span class="TOKEN">If</span> FaceId &lt;&gt; &quot;&quot; <span class="TOKEN">Then</span> SubMenuItem.FaceId = FaceId
<span class="TOKEN">If</span> Divider <span class="TOKEN">Then</span> SubMenuItem.BeginGroup = <span class="TOKEN">True</span>
<span class="TOKEN">End</span> Select
iRow = iRow + 1
<span class="TOKEN">Loop</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr>&nbsp;
<span class="TOKEN">Sub</span> DeleteMenu()
<span class="REM">' John Walkenbach: Microsoft Excel 2000 Bible Gold Edition, S. 1214 - 1217</span>
<span class="REM">' This sub should be executed when the workbook is closed</span>
<span class="REM">' Deletes the Menus</span>
<span class="REM">'/// Diese Prozedur sollte immer beim Schlie&szlig;en der Mappe ausgef&uuml;hrt werden</span>
<span class="REM">'/// L&ouml;scht den Men&uuml;punkt</span>
<span class="TOKEN">Dim</span> MenuSheet <span class="TOKEN">As</span> Worksheet
<span class="TOKEN">Dim</span> iRow <span class="TOKEN">As</span> <span class="TOKEN">Integer</span>
<span class="TOKEN">Dim</span> Caption <span class="TOKEN">As</span> <span class="TOKEN">String</span>
&nbsp;
<span class="TOKEN">On</span> <span class="TOKEN">Error</span> <span class="TOKEN">Resume</span> <span class="TOKEN">Next</span>
<span class="TOKEN">Set</span> MenuSheet = ThisWorkbook.Sheets(&quot;MenuSheet&quot;)
iRow = 2
<span class="TOKEN">Do</span> <span class="TOKEN">Until</span> IsEmpty(MenuSheet.Cells(iRow, 1))
<span class="TOKEN">If</span> MenuSheet.Cells(iRow, 1) = 1 <span class="TOKEN">Then</span>
Caption = MenuSheet.Cells(iRow, 2)
Application.CommandBars(1).Controls(Caption).Delete
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
iRow = iRow + 1
<span class="TOKEN">Loop</span>
<span class="TOKEN">On Error GoTo 0</span>
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span><hr>&nbsp;
<span class="TOKEN">Sub</span> DummyMacro()
<span class="REM">'/// zugewiesenes Makro f&uuml;r die Demonstration</span>
MsgBox &quot;This is a do-nothing macro.&quot;
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>
Code eingefügt mit dem MOF Code Converter (http://www.ms-office-forum.net/forum/codeconverter.php)</font>