Untermenü in persönlichen Menüs

Sub NeuesMenüEinfügen1() Dim i As Integer Dim i_Hilfe As Integer Dim MenuNew As CommandBarControl i = Application.CommandBars(1).Controls.Count i = Application.CommandBars(1).Controls.Count i_Hilfe = Application.CommandBars(1).Controls(i).Index Set MenuNew = Application.CommandBars(1).Controls.Add(Type:=msoControlPopup, Before:=i_Hilfe, Temporary:=True) MenuNew.Caption = "&Dienstplanorganizer" Set MB = MenuNew.Controls.Add(Type:=msoControlButton) With MB .Caption = "Startseite" .OnAction = "Hauptmenü" .FaceId = 1548 .BeginGroup = Flase End With Set MB = MenuNew.Controls.Add(Type:=msoControlButton) With MB .Caption = "Bildschirmauflösung" .FaceId = 1548 .BeginGroup = Flase End With Set MB = MenuNew.Controls.Add(Type:=msoControlButton) With MB .Caption = "Daten eingeben" .OnAction = "UserFormAnzeigen" .FaceId = 592 .BeginGroup = Flase End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Martin!
Das geht so.

Option Explicit

Sub NeuesMenueEinfuegen1()
Dim intIndex As Integer
Dim objCbMenu As CommandBarPopup, objCbPop As CommandBarPopup, objCbBtn As CommandBarButton

NeuesMenueLoeschen

intIndex = Application.CommandBars("Worksheet Menu Bar").FindControl(ID:=30010).Index

Set objCbMenu = Application.CommandBars(1).Controls.Add(Type:=msoControlPopup, Before:=intIndex, Temporary:=True)

objCbMenu.Caption = "&Dienstplanorganizer"

Set objCbBtn = objCbMenu.Controls.Add(Type:=msoControlButton)

With objCbBtn
  .Caption = "Startseite"
  .OnAction = "Hauptmenü"
  .FaceId = 1548
End With

Set objCbPop = objCbMenu.Controls.Add(Type:=msoControlPopup)

With objCbPop
  .Caption = "Bildschirmauflösung"
End With

Set objCbBtn = objCbPop.Controls.Add(msoControlButton)

With objCbBtn
  .Caption = "17 Zoll"
  .OnAction = "zoll17"
  .FaceId = 69
End With

Set objCbBtn = objCbPop.Controls.Add(msoControlButton)

With objCbBtn
  .Caption = "19 Zoll"
  .OnAction = "zoll19"
  .FaceId = 69
End With

Set objCbBtn = objCbMenu.Controls.Add(Type:=msoControlButton)

With objCbBtn
  .Caption = "Daten eingeben"
  .OnAction = "UserFormAnzeigen"
  .FaceId = 592
End With

Set objCbMenu = Nothing
Set objCbBtn = Nothing
Set objCbPop = Nothing
End Sub

Sub NeuesMenueLoeschen1()
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("&Dienstplanorganizer").Delete
On Error GoTo 0
End Sub

Gruß Sepp

Hallo Martin,
so könnte das aussehen:
Option Explicit


Sub NeuesMenüEinfügen1()
Dim intCount As Integer
Dim intTemp As Integer
Dim barMenu As CommandBarControl
Dim intBarNew As CommandBarControl
Dim barSubMenu As CommandBarControl
intCount = Application.CommandBars(1).Controls.Count
intTemp = Application.CommandBars(1).Controls(intCount).Index
Set barMenu = Application.CommandBars(1).Controls.Add(Type:=msoControlPopup, Before:=intTemp, Temporary:=True)
barMenu.Caption = "&Dienstplanorganizer"
Set intBarNew = barMenu.Controls.Add(Type:=msoControlButton)
With intBarNew
.Caption = "Startseite"
.OnAction = "Hauptmenü"
.FaceId = 1548
.BeginGroup = True
End With
Set intBarNew = barMenu.Controls.Add(Type:=msoControlPopup)
With intBarNew
.Caption = "Bildschirmauflösung"
.BeginGroup = False
' FaceId geht bei Untermenüs nicht
'.FaceId = 1548
End With
Set barSubMenu = intBarNew.Controls.Add(Type:=msoControlButton)
With barSubMenu
.Caption = "17 Zoll"
.OnAction = "Zoll17"
.BeginGroup = False
End With
Set barSubMenu = intBarNew.Controls.Add(Type:=msoControlButton)
With barSubMenu
.Caption = "19 Zoll"
.OnAction = "Zoll19"
.BeginGroup = False
End With
Set intBarNew = barMenu.Controls.Add(Type:=msoControlButton)
With intBarNew
.Caption = "Daten eingeben"
.OnAction = "UserFormAnzeigen"
.FaceId = 592
.BeginGroup = False
End With
End Sub


Sub Zoll17()
MsgBox "17 Zoll"
End Sub


Sub Zoll19()
MsgBox "19 Zoll"
End Sub


Sub UserFormAnzeigen()
MsgBox "UserFormAnzeigen"
End Sub


Sub HauptMenü()
MsgBox "Hauptmenü"
End Sub

Gruss
Markus

Beliebteste Forumthreads (12 Monate)

Untermenü in persönlichen Menüs

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Untermenü in persönlichen Menüs

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

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread