Eigenes Context Menü für Maus
19.07.2005 10:59:14
Heinz
Habe untestehenden VBA Code,für ein eigenes Menü wenn ich auf die rechte Maustaste drücke,von einem Excel User bei Euch bekommen.Funkt.in einen eigenen Pogramm super.
Nun habe ich den Code für eine andere Arbeitsmappe eingefügt.
Es tut sich gar nichts.Habe ich etwas falsch gemacht oder fehlt etwas ?
Könnte mir bitte jemand helfen ?
Danke & gruß Heinz
Dim rng As Range
Sub EditContext()
On Error Resume Next
ResetContext
With Application.CommandBars("Cell")
Do While .Controls.Count > 0
.Controls(1).Delete
Loop
Set oBtn1 = .Controls.Add
Set oBtn2 = .Controls.Add
Set oBtn3 = .Controls.Add
Set oBtn4 = .Controls.Add
Set oBtn5 = .Controls.Add
Set oBtn6 = .Controls.Add
End With
With oBtn1
.BeginGroup = True
.Caption = "SCHICHT_A"
.OnAction = "SCHICHT_A1"
.FaceId = 81
End With
With oBtn2
.Caption = "SCHICHT_B"
.OnAction = "SCHICHT_B1"
.FaceId = 85
End With
With oBtn3
.Caption = "SCHICHT_C"
.OnAction = "SCHICHT_C1"
.FaceId = 90
End With
With oBtn4
.Caption = "URLAUB"
.OnAction = "URLAUB1"
.FaceId = 95
End With
With oBtn5
.Caption = "KRANK"
.OnAction = "KRANK1"
.FaceId = 100
End With
With oBtn6
.Caption = "REGIE"
.OnAction = "REGIE1"
.FaceId = 105
End With
End Sub
Sub ResetContext()
Application.CommandBars("Cell").Reset
End Sub
Sub Urlaub1()
Application.ScreenUpdating = False
For Each rng In Selection
If rng.Row > 5 And rng.Row < 53 And rng.Offset(0, -10) <> "" Then rng.Value = "Urlaub"
Next
Application.ScreenUpdating = True
End Sub
Sub Krank1()
Application.ScreenUpdating = False
For Each rng In Selection
If rng.Row > 5 And rng.Row < 53 And rng.Offset(0, -10) <> "" Then rng.Value = "Krank"
Next
Application.ScreenUpdating = True
End Sub
Sub SCHICHT_A1()
Application.ScreenUpdating = False
For Each rng In Selection
If rng.Row > 5 And rng.Row < 53 And rng.Offset(0, -10) <> "" Then rng.Value = "SCHICHT-A"
Next
Application.ScreenUpdating = True
End Sub
Sub SCHICHT_B1()
Application.ScreenUpdating = False
For Each rng In Selection
If rng.Row > 5 And rng.Row < 53 And rng.Offset(0, -10) <> "" Then rng.Value = "SCHICHT_B"
Next
Application.ScreenUpdating = True
End Sub
Sub SCHICHT_C1()
Application.ScreenUpdating = False
For Each rng In Selection
If rng.Row > 5 And rng.Row < 53 And rng.Offset(0, -10) <> "" Then rng.Value = "SCHICHT_C"
Next
Application.ScreenUpdating = True
End Sub
Sub REGIE1()
Application.ScreenUpdating = False
For Each rng In Selection
If rng.Row > 5 And rng.Row < 53 And rng.Offset(0, -10) <> "" Then rng.Value = "REGIE"
Next
Application.ScreenUpdating = True
End Sub