Menüpunkt

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Menüpunkt

05.04.2005 18:25:22

ransi

AW: Menüpunkt

05.04.2005 18:31:15

Seppl

AW: Menüpunkt

05.04.2005 18:48:49

GraFri

AW: Menüpunkt

05.04.2005 19:04:27

Ceyser

AW: Menüpunkt

05.04.2005 19:13:34

Ceyser

... reset kann so einfach einfach sein, und..

05.04.2005 19:22:19

ransi

Hallo
Vielleicht hilft dir folgender Code weiter.

' ----------------------------------------------------------------------
' Code in 'DieseArbeitsmappe'
'
' Erstellt einen neuen Menüpunkt mit Untermenüeinträge
'
'
Option Explicit
' Name des neuen Menüeintrages
Const menuName  As String = "&Werkzeuge"
Private Sub Workbook_Open()
Dim ML          As CommandBar
Dim U1          As CommandBarControl
Dim Punkt       As CommandBarControl
Set ML = Application.CommandBars("Worksheet Menu Bar")
' Name für neues Menü wird gesetzt
  Set U1 = ML.Controls.Add(Type:=msoControlPopup, Before:=10)
  U1.Caption = menuName
  U1.Tag = "MeinMenü" ' dient zur eindeutigen Identifizierung des Menüs

' 1. Menüpunkt wird angelegt
  Set Punkt = U1.Controls.Add(Type:=msoControlButton)
  With Punkt
    .Caption = "Tabelle1"
    .OnAction = "Makro_1"
    .Style = msoButtonIconAndCaption
    .FaceId = 500
  End With
' 2. Menüpunkt wird angelegt
  Set Punkt = U1.Controls.Add(Type:=msoControlButton)
  With Punkt
    .Caption = "Tabelle2"
    .OnAction = "Makro_2"
    .Style = msoButtonIconAndCaption
    .FaceId = 800
  End With
' 3. Menüpunkt wird angelegt
  Set Punkt = U1.Controls.Add(Type:=msoControlButton)
  With Punkt
    .Caption = "Tabelle3"
    .OnAction = "Makro_3"
    .Style = msoButtonIconAndCaption
    .FaceId = 733
  End With
' usw
' usw

End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ML          As CommandBar
Set ML = Application.CommandBars("Worksheet Menu Bar")
  On Error Resume Next ' Fehlerbehandlung
  ML.FindControl(Tag:="MeinMenü").Delete
End Sub
' ----------------------------------------------------------------------

' ----------------------------------------------------------------------
' Code in 'DieseArbeitsmappe'

Option Explicit
mfg, GraFri

Hi Seppl,
ich habe auch eine Variante entwickelt. Ist etwas kürzer.

Option Explicit
Sub Symbolleiste_Sheets_erstellen()
Dim CB As CommandBar
Dim CBC As CommandBarButton
Dim CBP As CommandBarPopup
Dim i%
On Error Resume Next
Application.CommandBars("Meine Leiste").Delete
Set CB = Application.CommandBars.Add(name:="Meine Leiste", _
    temporary:=True, Position:=msoBarTop)
On Error GoTo 0
If Application.CommandBars("Meine Leiste").Visible = False Then
    CB.Visible = True
    Set CBP = CB.Controls.Add(Type:=msoControlPopup)
    With CBP
        .Caption = "Sheets"
    End With
    For i = 1 To ActiveWorkbook.Sheets.Count
        Set CBC = CBP.Controls.Add(Type:=msoControlButton)
        With CBC
            .Style = msoButtonCaption
            .FaceId = 3
            .Caption = ActiveWorkbook.Worksheets(i).name
            .OnAction = "aktivieren"
        End With
    Next i
End If
End Sub
Gruß
CS

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread