Microsoft Excel

Herbers Excel/VBA-Archiv

An Heiko-Eigenes Context Menü für Maus

Betrifft: An Heiko-Eigenes Context Menü für Maus von: Heinz H
Geschrieben am: 19.07.2005 14:24:32

Hallo Heiko
Habe Deine Hilfe ausprobiert,leider ohne Erfolg.
Könntest Du mir Bitte noch einmal helfen ??
Danke Heinz


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
Application.ScreenUpdating = False 'Anzeige des Makros
Worksheets("Hauptblatt").Activate
Worksheets("Hauptblatt").ComboBox1.Visible = False ' True '
Range("A1:A1").Select
Range("A1").Select
Next
Application.ScreenUpdating = True
If ThisWorkbook.Worksheets("Hauptblatt").Range("G21") >= 0 Then ersteFarbe
End Sub

  


Betrifft: AW: An Heiko-Eigenes Context Menü für Maus von: Rocky
Geschrieben am: 19.07.2005 14:30:24

du hast zweimal application.screenupdating auf false gesetzt aber nur einmal auf true nimm mal dass zweite davon raus!

unten ist ne doppel deklaration drin range("A1:A1") ist doch das selbe wie Range("A1") oder auch cells(1,1)

gruß rocky


  


Betrifft: AW: An Heiko-Eigenes Context Menü für Maus von: Heinz H
Geschrieben am: 19.07.2005 14:46:38

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



  


Betrifft: AW: An Heiko-Eigenes Context Menü für Maus von: Rocky
Geschrieben am: 19.07.2005 14:51:42

also nochmal langsam:

du stopfst den ganzen schmus in ein MODUL und schreibst dann in "DieseArbeitsmappe" unter Workbook_Open()

die sachen die du da vorhin auch drin hattest und am schluss schreibst du noch hinzu


....

Call EditContext

Application.Screenupdating = False

end Sub

Alles klar wenn nich einfach posten!

gruß Rocky


  


Betrifft: Nachtrag von: Rocky
Geschrieben am: 19.07.2005 14:59:03

um die sache zu löschen unter workbook_beforeclose()

call resetcontext

gruß Rocky


  


Betrifft: AW: An Heiko-Eigenes Context Menü für Maus von: Heinz H
Geschrieben am: 19.07.2005 17:14:14

Hallo Rocky
Ich bring's leider nicht hin.
Auch nicht das ich die Datei auf 300Kb schrumpfe um sie Hochzuladen.
Trotzdem Herzlichen Dank für Deine Hilfe.
Gruß Heinz


  


Betrifft: nachtrag von: Rocky
Geschrieben am: 19.07.2005 14:46:09

ich bin's nochmal,

ich frage mich bein lesen wo die verbindung zu deiner Betreffzeile ist?

hab mir mal deinen tread weiter unten durchgelesen du muss nur noch einfügen

.....

Call 'und dein Makroname für das erstellen des kontextmenüs

hoffe ich verstah dich richtig gruß Rocky


  


Betrifft: AW: nachtrag von: Heinz H
Geschrieben am: 19.07.2005 17:42:06

Hallo Rocky
Habe eine Test Mappe gemacht,so wie sie in der richtigen Arbeitsmappe steht.
Könntest Du mir bitte Anhand dieser Testmappe weiterhelfen ??
Danke Heinz

https://www.herber.de/bbs/user/24820.xls


  


Betrifft: ^Du hattest ja schon fast :-) von: Rocky
Geschrieben am: 20.07.2005 07:55:04

Hallo Ich bin's wieder,

also du hast es schon fast gehabt.

ich heng dir dein Dat wieder ran. schau dir aber bitte den code mal an dann wirst du auch die sachen verstehen die dir die leute so schreiben und dann werden sich in zukunft vieleicht einige fragen von allein regeln.

https://www.herber.de/bbs/user/24831.xls


Gruß Rocky


  


Betrifft: AW: ^Du hattest ja schon fast :-) von: Heinz H
Geschrieben am: 20.07.2005 12:58:28

Hallo Rocky
Danke für Deine Hilfe !!
Werde Deinen Ratschlag in Zukunft befolgen.

Gruß Heinz