AW: Fehler in Kontextmenü
20.07.2005 18:41:27
Heinz
Hallo Volker
Gerne sende ich Dir den gewünschten Code.
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 1"
.OnAction = "Schicht11"
.FaceId = 81
End With
With oBtn2
.Caption = "SCHICHT 2"
.OnAction = "Schicht21"
.FaceId = 85
End With
With oBtn3
.Caption = "SCHICHT 3"
.OnAction = "Schicht31"
.FaceId = 90
End With
With oBtn4
.Caption = "REGIE"
.OnAction = "Regie1"
.FaceId = 95
End With
With oBtn5
.Caption = "URLAUB"
.OnAction = "Urlaub1"
.FaceId = 100
End With
With oBtn6
.Caption = "KRANK"
.OnAction = "Krank1"
.FaceId = 105
End With
End Sub
Sub ResetContext()
Application.CommandBars("Cell").Reset
End Sub
Sub Schicht11()
Application.ScreenUpdating = False
For Each rng In Selection
If rng.Row > 5 And rng.Row < 53 And rng.Offset(0, -3) <> "" Then rng.Value = "SCHICHT 1"
Next
Application.ScreenUpdating = True
End Sub
Sub Schicht21()
Application.ScreenUpdating = False
For Each rng In Selection
If rng.Row > 5 And rng.Row < 53 And rng.Offset(0, -3) <> "" Then rng.Value = "SCHICHT 2"
Next
Application.ScreenUpdating = True
End Sub
Sub Schicht31()
Application.ScreenUpdating = False
For Each rng In Selection
If rng.Row > 5 And rng.Row < 53 And rng.Offset(0, -3) <> "" Then rng.Value = "SCHICHT 3"
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, -3) <> "" Then rng.Value = "REGIE"
Next
Application.ScreenUpdating = True
End Sub
Sub Urlaub1()
Application.ScreenUpdating = False
For Each rng In Selection
If rng.Row > 5 And rng.Row < 53 And rng.Offset(0, -3) <> "" 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, -3) <> "" Then rng.Value = "KRANK"
Next
Application.ScreenUpdating = True
End Sub