AW: An Heiko-Eigenes Context Menü für Maus
19.07.2005 14:46:38
Heinz H
Hallo Rocky
Habe Deinen Rat befolgt.Leider ohne Erfolg.
Bin einfach noch zu unwissend.
Habe unten die Codes von Modul & Dieser Arbeitsmappe eingefügt.Könntest Du mir Bitte an Hand dieser Codes weiterhelfen??
Danke 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 = "Bildungsurlaub"
.OnAction = "Bildungsurlaub1"
.FaceId = 81
End With
With oBtn2
.Caption = "Feiertag"
.OnAction = "Feiertag1"
.FaceId = 85
End With
With oBtn3
.Caption = "Krank"
.OnAction = "Krank1"
.FaceId = 90
End With
With oBtn4
.Caption = "Pflegefreistellung"
.OnAction = "Pflegefreistellung1"
.FaceId = 95
End With
With oBtn5
.Caption = "Urlaub"
.OnAction = "Urlaub1"
.FaceId = 100
End With
With oBtn6
.Caption = "Zeitausgleich"
.OnAction = "Zeitausgleich1"
.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 Zeitausgleich1()
Application.ScreenUpdating = False
For Each rng In Selection
If rng.Row > 5 And rng.Row < 53 And rng.Offset(0, -10) <> "" Then rng.Value = "Zeitausgleich"
Next
Application.ScreenUpdating = True
End Sub
Sub Feiertag1()
Application.ScreenUpdating = False
For Each rng In Selection
If rng.Row > 5 And rng.Row < 53 And rng.Offset(0, -10) <> "" Then rng.Value = "Feiertag"
Next
Application.ScreenUpdating = True
End Sub
Sub Bildungsurlaub1()
Application.ScreenUpdating = False
For Each rng In Selection
If rng.Row > 5 And rng.Row < 53 And rng.Offset(0, -10) <> "" Then rng.Value = "Bildungsurlaub"
Next
Application.ScreenUpdating = True
End Sub
Sub Pflegefreistellung1()
Application.ScreenUpdating = False
For Each rng In Selection
If rng.Row > 5 And rng.Row < 53 And rng.Offset(0, -10) <> "" Then rng.Value = "Pflegefreistellung"
Next
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_Open()
Application.ScreenUpdating = False 'Anzeige des Makros
Application.StatusBar = "Heute ist der: " & Format(Date, "dd.mm.yyyy")
Application.Caption = "Arbeitsnachweis"
Application.CommandBars("Visual Basic").Visible = False 'blendet Symbolleiste VB aus
Dim Sheet As Worksheet
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Activate
With ActiveWindow
.DisplayHeadings = False 'True
.DisplayWorkbookTabs = False 'True
.DisplayGridlines = False 'True
End With
Worksheets("Hauptblatt").Activate
Worksheets("Hauptblatt").ComboBox1.Visible = False ' True '
Range("A1").Select
Next
Application.ScreenUpdating = True
'If ThisWorkbook.Worksheets("Hauptblatt").Range("G21") >= 0 Then ersteFarbe
End Sub
Private Sub Workbook_Deactivate()
Application.CommandBars("ply").Enabled = False
'Ende Tabellenblatt Menü ausblenden'
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False 'Anzeige des Makros
Dim Ini As Integer
For Ini = Sheets.Count To 1 Step -1
If Sheets(Ini).Name <> "Hauptblatt" Then Sheets(Ini).Visible = xlVeryHidden
Next Ini
Application.CommandBars("Visual Basic").Visible = True
Dim Sheet As Worksheet
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Activate
With ActiveWindow
.DisplayGridlines = True 'True
.DisplayHeadings = True 'True
.DisplayWorkbookTabs = True 'True
End With
Next
Worksheets("Hauptblatt").ComboBox1.Visible = False 'True '
ThisWorkbook.Close False
End Sub