AW: Letzter Versuch!
folgender
Hallo Rainer,
folgende Code´s werden markiert,
Function istFeiertag(datum, Feiertage)
istFeiertag = 1
For f = 1 To 31
If datum = Feiertage(f) Then istFeiertag = 2
Next f
End Function
Sub Auto_Open()
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 = "&Zeitenplaner"
U1.Tag = "Zeitenplaner" ' dient zur eindeutigen Identifizierung des Menüs
' neues Untermenü wird hinzugefügt
Set Punkt = U1.Controls.Add(Type:=msoControlPopup)
With Punkt
.Caption = "Eingabe"
End With
Set U2 = Punkt ' Variable für das 2. Untermenü wird gesetzt
'Neuer Menüeintrag im 2.Untermenü
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Januar"
.OnAction = "formular1"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Februar"
.OnAction = "formular2"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Maerz"
.OnAction = "formular3"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&April"
.OnAction = "formular4"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Mai"
.OnAction = "formular5"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Juni"
.OnAction = "formular6"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Juli"
.OnAction = "formular7"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&August"
.OnAction = "formular8"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&September"
.OnAction = "formular9"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Oktober"
.OnAction = "formular10"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&November"
.OnAction = "formular11"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Dezember"
.OnAction = "formular12"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U1.Controls.Add(Type:=msoControlPopup)
With Punkt
.Caption = "Drucken Urlaubskalender"
End With
Set U2 = Punkt
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Januar"
.OnAction = "januarK"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Februar"
.OnAction = "februarK"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Maerz"
.OnAction = "MärzK"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&April"
.OnAction = "aprilK"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Mai"
.OnAction = "MaiK"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Juni"
.OnAction = "juniK"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Juli"
.OnAction = "juliK"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&August"
.OnAction = "augustK"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&September"
.OnAction = "septemberK"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Oktober"
.OnAction = "oktoberK"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&November"
.OnAction = "novemberK"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Dezember"
.OnAction = "dezemberK"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&alle Monate"
.OnAction = "zwölf_Blätter_Druck"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U1.Controls.Add(Type:=msoControlPopup)
With Punkt
.Caption = "Drucken Stundenzettel"
End With
Set U2 = Punkt
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Januar"
.OnAction = "januarS"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Februar"
.OnAction = "februarS"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Maerz"
.OnAction = "märzS"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&April"
.OnAction = "aprilS"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Mai"
.OnAction = "maiS"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Juni"
.OnAction = "juniS"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&juli"
.OnAction = "Makro3"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&August"
.OnAction = "augustS"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&September"
.OnAction = "septemberS"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Oktober"
.OnAction = "oktoberS"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&November"
.OnAction = "novemberS"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Dezember"
.OnAction = "dezemberS"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U1.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Tagesansicht"
.OnAction = "Tagesansicht"
.Style = msoButtonIconAndCaption
.FaceId = 2103
End With
Set Punkt = U1.Controls.Add(Type:=msoControlPopup)
With Punkt
.Caption = "Monatsansicht"
End With
Set U2 = Punkt ' Variable für das 2. Untermenü wird gesetzt
'Neuer Menüeintrag im 2.Untermenü
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Januar"
.OnAction = "JanuarA"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Februar"
.OnAction = "FebruarA"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Maerz"
.OnAction = "MärzA"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&April"
.OnAction = "AprilA"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Mai"
.OnAction = "MaiA"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Juni"
.OnAction = "JuniA"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Juli"
.OnAction = "JuliA"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&August"
.OnAction = "AugustA"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&September"
.OnAction = "SeptemberA"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Oktober"
.OnAction = "OktoberA"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&November"
.OnAction = "NovemberA"
.Style = msoButtonIconAndCaption
End With
Set Punkt = U2.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Dezember"
.OnAction = "DezemberA"
.Style = msoButtonIconAndCaption
End With
' Weiterer Eintrag im 1.Untermenü
Set Punkt = U1.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Jahresansicht"
.OnAction = "Jahresansicht"
.Style = msoButtonIconAndCaption
.FaceId = 2103
End With
Set Punkt = U1.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Jahresvergleich"
.OnAction = "Jahresvergleich"
.Style = msoButtonIconAndCaption
.FaceId = 2103
End With
Set Punkt = U1.Controls.Add(Type:=msoControlButton)
With Punkt
.Caption = "&Kalender"
.OnAction = "Urlaubskalender"
.Style = msoButtonIconAndCaption
.FaceId = 2103
End With
Sheets("Kalender").Select
Application.DisplayFullScreen = True
Application.DisplayFormulaBar = False
Toolbars(1).Visible = False
Toolbars(2).Visible = False
With ActiveWindow
.DisplayHeadings = False
.DisplayWorkbookTabs = False
End With
Call januar
Dim strWks As String
strWks = InputBox(Prompt:="Bitte Passwort eingeben:", Default:="")
If strWks <> "kron" Then
Set ML = Application.CommandBars("Worksheet Menu Bar")
On Error Resume Next ' Fehlerbehandlung
ML.FindControl(Tag:="Zeitenplaner").Delete
MsgBox "Falsches Passwort"
Else
For I = 1 To Sheets.Count
Sheets(I).Protect ("kron")
Next I
End If
End Sub
Sub Auto_Close()
Set ML = Application.CommandBars("Worksheet Menu Bar")
On Error Resume Next ' Fehlerbehandlung
ML.FindControl(Tag:="Zeitenplaner").Delete
Application.DisplayFullScreen = False
Toolbars(1).Visible = True
Toolbars(2).Visible = True
With ActiveWindow
.DisplayHeadings = True
.DisplayWorkbookTabs = True
End With
For I = 1 To Sheets.Count
Sheets(I).Protect ("kron")
Next I
End Sub
Gruß
Hamza