Spezialmenu mit Untermenu erstellen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Peter!
Das Posting sollte auch zu einem anderen Peter ;-))
Das was du willst, geht z.B. so.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Const menueName As String = "Dieters Spezialmenu"
Private Const strPW As String = "pw" ' dein Passwort - anpassen!

Sub makeMenue()
Dim objCBar As CommandBar
Dim objCMenu As CommandBarPopup, objCPop As CommandBarPopup
Dim objCBtn As CommandBarButton
Dim intC As Integer

deleteMenue

'Zuweisen der Objectvariablen
Set objCBar = Application.CommandBars("Worksheet Menu Bar")
Set objCMenu = objCBar.Controls.Add(Type:=msoControlPopup)
'Titelbeschriftung der Menübar
objCMenu.Caption = menueName

'Einen Button hinzufügen und diesen gleich beschriften
Set objCBtn = objCMenu.Controls.Add(Type:=msoControlButton)
With objCBtn
  .Style = msoButtonIconAndCaption
  .Caption = "Menü aktivieren"
  .OnAction = "activateMenu"
  .FaceId = 343
End With

'Popup hinzufügen
Set objCPop = objCMenu.Controls.Add(Type:=msoControlPopup)
With objCPop
  .Caption = "Einen Drucker auswählen"
  .Enabled = False
End With
'Buttons zum Popup hinzufügen
Set objCBtn = objCPop.Controls.Add(Type:=msoControlButton)
With objCBtn
  .Style = msoButtonIconAndCaption
  .Caption = "Aktiver Drucker"
  .OnAction = "Makro16"
  .FaceId = 4
End With
Set objCBtn = objCPop.Controls.Add(Type:=msoControlButton)
With objCBtn
  .Style = msoButtonIconAndCaption
  .Caption = "Drucken auf LPQ3"
  .OnAction = "Makro17"
  .FaceId = 4
End With

'Popup hinzufügen
Set objCPop = objCMenu.Controls.Add(Type:=msoControlPopup)
With objCPop
  .Caption = "Name in den Diagrammen ändern"
  .Enabled = False
End With
'Buttons zum Popup hinzufügen
Set objCBtn = objCPop.Controls.Add(Type:=msoControlButton)
With objCBtn
  .Style = msoButtonIconAndCaption
  .Caption = "D.Thönnißen"
  .OnAction = "Makro35"
  .FaceId = 17
End With
Set objCBtn = objCPop.Controls.Add(Type:=msoControlButton)
With objCBtn
  .Style = msoButtonIconAndCaption
  .Caption = "J.Rost"
  .OnAction = "Makro36"
  .FaceId = 17
End With

'Popup hinzufügen
Set objCPop = objCMenu.Controls.Add(Type:=msoControlPopup)
With objCPop
  .Caption = "Monate in den Diagrammen ändern"
  .Enabled = False
End With
'Buttons zum Popup hinzufügen
For intC = 1 To 12
  Set objCBtn = objCPop.Controls.Add(Type:=msoControlButton)
  With objCBtn
    .Style = msoButtonIconAndCaption
    .Caption = Format(DateSerial(1, intC, 1), "mmmm")
    .OnAction = "'MonatAendern""" & intC & """'"
    .FaceId = 16
  End With
Next

Set objCBar = Nothing
Set objCMenu = Nothing
Set objCBtn = Nothing
Set objCPop = Nothing

End Sub

Sub deleteMenue()
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls(menueName).Delete
On Error GoTo 0
End Sub

Sub MonatAendern(intMonth As Integer)
'Wenn man das zu ändernde Monat als Argument übergibt, braucht man nur ein Makro für alle Monate!
MsgBox "Monat " & Format(DateSerial(1, intMonth, 1), "mmmm") & " geändert!"
End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Spezialmenu mit Untermenu erstellen

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread