Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 13:44:37
Datum in Excelformel anzeigen
23.04.2024 13:31:41
alle Tabellblätter als csv exportieren - Verzeichnis wählen
23.04.2024 13:19:18
Daten aus externer Datei als Bereich übernehmen... ?
23.04.2024 12:57:21
Makro für aktuell geöffn. Datei mit gleichen Namen speichern
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
796to800
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
796to800
796to800
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

@ Josef Ehrensberger

@ Josef Ehrensberger
02.09.2006 19:01:06
Peter
Hallo Excelfreund
am 27.08.06 habe ich von dir einen Vba Code zum erstellen eines Menupunktes
"Mein Spezialmenu" bekommen.
Dieses Extramenu ist mit einer Passwortabfrage und Unterordnern versehen.
OK läuft alles wunderbar. ;-)
Ist es möglich noch einen Menupunkt erstellen.
Dieser soll aber:
1. Allen zugänglich sein (Ohne Passwortabfrage)
2. 3 Punkte beinhalten (mit Icon) Super idee.
3. Nur für diese Datei vorhanden sein.
(Also beim öffnen einer anderen Datei nicht vorhanden sein)
Ist das möglich wenn ich das andere Menu beibehalte.
Gruß Peter

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: @ Josef Ehrensberger
02.09.2006 19:12:37
Josef
Hallo Peter!
Klar geht das.
Zeig mal deinen jetzigen Code zum Erstellen des Menüs und den Code den du unter "DieseArbeitsmappe" stehen hast.
Gruß Sepp

AW: @ Josef Ehrensberger
02.09.2006 19:25:47
Peter
Hallo Sepp
hier der Code
Kannst du den so umbauen das beide Menus dann funktionieren.?
Allerdings habe ich 2 unterschiedliche Dateien. (1 mal mit und ohne Untermenu)
Diese hier ist ohne Untermenu:
DieseArbeitsmappe:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
HideSheets True
Me.Save
deleteMenue
End Sub



Private Sub Workbook_Activate()
makeMenue
End Sub



Private Sub Workbook_Deactivate()
deleteMenue
End Sub

Unter Makro:
Option Explicit
Private Const menueName As String = "Spezialmenu"
Private Const strPW As String = "mein Passwort" ' dein Passwort - anpassen!
Sub makeMenue()
Dim cbMenu As CommandBar
Dim cbSpecialMenu As CommandBarPopup
Dim cbCommand As CommandBarButton
deleteMenue
'Zuweisen der Objectvariablen
Set cbMenu = Application.CommandBars("Worksheet Menu Bar")
Set cbSpecialMenu = cbMenu.Controls.Add(Type:=msoControlPopup)
'Titelbeschriftung der Menübar
cbSpecialMenu.Caption = menueName
'Einen Button hinzufügen und diesen gleich beschriften
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Menü aktivieren"
.OnAction = "activateMenu"
.FaceId = 343
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Einen Drucker auswählen"
.OnAction = ""
.FaceId = 1
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Aktiver Drucker"
.OnAction = "Makro15"
.FaceId = 4
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Drucken auf LPQ3"
.OnAction = "Makro14"
.FaceId = 4
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = ""
.OnAction = ""
.FaceId = 1
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Monate in den Diagrammen ändern"
.OnAction = ""
.FaceId = 1
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Januar"
.OnAction = "Makro1"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Februar"
.OnAction = "Makro2"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "März"
.OnAction = "Makro3"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "April"
.OnAction = "Makro4"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Mai"
.OnAction = "Makro5"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Juni"
.OnAction = "Makro6"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Juli"
.OnAction = "Makro7"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "August"
.OnAction = "Makro8"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "September"
.OnAction = "Makro9"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Oktober"
.OnAction = "Makro10"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "November"
.OnAction = "Makro11"
.FaceId = 16
.Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Dezember"
.OnAction = "Makro12"
.FaceId = 16
.Enabled = False
End With
Set cbMenu = Nothing
Set cbCommand = Nothing
Set cbSpecialMenu = Nothing
End Sub
Sub deleteMenue()
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls(menueName).Delete
On Error GoTo 0
End Sub 

Private Sub activateMenu()
Dim objCntrl As CommandBarControl
If InputBox("      Passwort:", "Hier das Passwort zum Freischalten eingeben:") = strPW Then
For Each objCntrl In Application.CommandBars.ActionControl.Parent.Controls
objCntrl.Enabled = True
Next
With Application.CommandBars.ActionControl
.FaceId = 343
.Enabled = False
End With
Else
MsgBox "Falsches Passwort!", 64, "Fehler"
End If
End Sub

Gruß Peter
Anzeige
AW: @ Josef Ehrensberger
02.09.2006 19:41:01
Josef
Hallo Peter!
Ich weis nicht ob ich dich richtig verstanden habe, aber probier mal.
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
HideSheets True
Me.Save
deleteMenue
End Sub



Private Sub Workbook_Activate()
changeMenue True
End Sub




Private Sub Workbook_Deactivate()
changeMenue
End Sub


Private Sub Workbook_Open()
makeMenue
End Sub


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

Option Explicit

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

Sub makeMenue()
Dim cbMenu As CommandBar
Dim cbSpecialMenu As CommandBarPopup
Dim cbCommand As CommandBarButton

deleteMenue

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

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

'Neu##
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Permanent"
  .OnAction = "NeuesMakro"
  .FaceId = 59
  .Tag = "perma"
End With
'##

Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Einen Drucker auswählen"
  .OnAction = ""
  .FaceId = 1
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Aktiver Drucker"
  .OnAction = "Makro15"
  .FaceId = 4
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Drucken auf LPQ3"
  .OnAction = "Makro14"
  .FaceId = 4
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = ""
  .OnAction = ""
  .FaceId = 1
  .Enabled = False
End With

Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Monate in den Diagrammen ändern"
  .OnAction = ""
  .FaceId = 1
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Januar"
  .OnAction = "Makro1"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Februar"
  .OnAction = "Makro2"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "März"
  .OnAction = "Makro3"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "April"
  .OnAction = "Makro4"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Mai"
  .OnAction = "Makro5"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Juni"
  .OnAction = "Makro6"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Juli"
  .OnAction = "Makro7"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "August"
  .OnAction = "Makro8"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "September"
  .OnAction = "Makro9"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Oktober"
  .OnAction = "Makro10"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "November"
  .OnAction = "Makro11"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Dezember"
  .OnAction = "Makro12"
  .FaceId = 16
  .Enabled = False
End With



Set cbMenu = Nothing
Set cbCommand = Nothing
Set cbSpecialMenu = Nothing

End Sub

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


Sub changeMenue(Optional ByVal modus As Boolean = False)
Dim objCtrl As CommandBarControl

For Each objCtrl In Application.CommandBars("Worksheet Menu Bar").Controls(menueName).Controls
  If modus Then
    If objCtrl.Tag <> "perma" Then
      objCtrl.Enabled = Cbool(objCtrl.Tag)
    End If
  Else
    If objCtrl.Tag <> "perma" Then
      objCtrl.Tag = CStr(Cbool(objCtrl.Enabled))
      objCtrl.Enabled = False
    End If
  End If
Next

End Sub


Private Sub activateMenu()
Dim objCntrl As CommandBarControl

If InputBox(" Passwort:", "Hier das Passwort zum Freischalten eingeben:") = strPW Then
  For Each objCntrl In Application.CommandBars.ActionControl.Parent.Controls
    objCntrl.Enabled = True
  Next
  With Application.CommandBars.ActionControl
    .FaceId = 343
    .Enabled = False
  End With
Else
  
  MsgBox "Falsches Passwort!", 64, "Fehler"
  
End If
End Sub



Sub neuesMakro()
MsgBox "HALLO!"
End Sub


Gruß Sepp

Anzeige
AW: @ Josef Ehrensberger
02.09.2006 19:56:16
Peter
Hallo Sepp
Es sollte eigendlich ein neues Menu neben dem "alten Menu" stehen.
Aber so ist es auch Ok.
Ich erhalte jetzt eine MessageBox.
Wie kann ich jetzt hier 2 Makros zuweisen.
Also 2 zusätzliche Menupunkte mit 2 Makros.
Gruß Peter
AW: @ Josef Ehrensberger
02.09.2006 20:01:30
Peter
Hallo Sepp
es soll das hier angesteuert werden.

Sub ein()
HideSheets
End Sub



Sub aus()
HideSheets True
End Sub

Gruß Peter
AW: @ Josef Ehrensberger
02.09.2006 20:20:00
Josef
Hallo Peter!
Das hatten wir doch schon, oder?
Wenn du ein Popup willst, musst du anstelle des Buttons eben ein Popup erstellen und
anschliessend im Popup die Buttons einfügen.
Wenn du ein separates Menü willst, dann musst du eben ein Menü mit einem neuen Namen erstellen und die Buttons dort erstellem.
Gruß Sepp

Anzeige
AW: @ Josef Ehrensberger
02.09.2006 21:02:39
Peter
Hallo Sepp
die Einstellung in deinem Posting von 19:41h sind ja OK.
Aber wie bekomme ich jetzt anstatt dieser Messagebox die beiden Makros zum laufen.
Button 1=

Sub ein()
HideSheets
End Sub

Button 2=

Sub aus()
HideSheets True
Gruß Peter
End Sub

AW: @ Josef Ehrensberger
02.09.2006 21:10:17
Josef
Hallo Peter!
Das Makro wird mit

.OnAction = "ein"
'bzw.
.OnAction = "aus"

zugewiesen.
Gruß Sepp

AW: @ Josef Ehrensberger
02.09.2006 21:19:50
Peter
Hallo Sepp
ich habe alles hinbekommen.
Danke für deine hilfe
Gruß Peter
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige