Microsoft Excel

Herbers Excel/VBA-Archiv

Eigenes Context Menü für Maus

Betrifft: Eigenes Context Menü für Maus von: Heinz H
Geschrieben am: 19.07.2005 10:59:14

Hallo Leute

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

  


Betrifft: AW: Eigenes Context Menü für Maus von: Heiko S.
Geschrieben am: 19.07.2005 11:35:18

Hallo Heinz,

ich stell mal ne blöde Frage, (aber manchmal sind Lösungen so einfach).
Das du die Subs nicht nur in die neue Mappe kopieren mußt, sondern auch das Sub EditContext() einmal laufen lassen mußt (z.B. im Workbook_Open Ereigniss) ist klar und auch passiert ?!

Gruß Heiko

PS: Rückmeldung wäre nett !


  


Betrifft: AW: Eigenes Context Menü für Maus von: Heinz H
Geschrieben am: 19.07.2005 11:42:48

Hallo Heiko
Danke genau das war mein Fehler..

Ps:Es gibt keine blöden Fragen,nur blöde Antworten !!!

Nochmals danke für Deine Hilfe
Gruß Heinz