Markierungsaufhebung

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'UpdatebyExtendoffice6/1/2016 Dim rng1 As Range 'Dim rng2 As Range ActiveSheet.Unprotect Application.ScreenUpdating = False With Target .Worksheet.Cells.Interior.ColorIndex = 0 Set rng1 = Intersect(Range("A5:H35"), Target.EntireRow) If Not rng1 Is Nothing Then rng1.Interior.Color = RGB(204, 255, 204) ' Set rng2 = Intersect(Range("C5:M35"), Target.EntireColumn) ' If Not rng2 Is Nothing Then rng2.Interior.Color = RGB(255, 255, 197) End With Application.ScreenUpdating = True Set rng1 = Nothing ' Set rng2 = Nothing ActiveSheet.Protect End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo hary,
im Prinzip läuft es jetzt!
In "Diese Arbeitsmappe" steht jetzt:


Private Sub Workbook_Open()
With ThisWorkbook.Sheets(Format(Date, "MMM"))
.Activate
.Cells(Day(Date) + 4, 3).Select
End With
End Sub


Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
ActiveSheet.Unprotect
Sh.Range("A5:H35").Interior.ColorIndex = 0
End Sub

Beim Öffnen der Mappe wird jetzt zwar das aktuelle Monatsblatt und die Zelle mit dem aktuellen Tag angezeigt, aber diese ist nicht aktiviert und keine Markierung ist erfolgt. Beim Mausklick darauf erfolgt auch keine Markierung! Erst wenn ich in eine andere Zelle klicke erfolgt die Markierung!
Nach dem Löschen der Markierungen in den anderen Blättern beim Blattwechsel über obige Makro, sollte im Prinzip immer die aktuelle Tageszelle im aktuellen Monat aktiviert werden und somit auch die Markierung erfolgen!
Kann man das noch irgendwie ändern?
LG
mike49

Sorry hary, dass ich mich jetzt erst melde. Ich musste kurzfristig außer Haus und bin erst jetzt wieder zurück.
Ich habe das Makro mal getestet und es funktioniert. Leider weren aber auch alle anderen Farbmarkierungen entfernt!
Ich habe es mal so abgeändert und es funktioniert aber nur wenn die Blätter keinen Blattschutz haben.
Lieber wäre mir aber, wenn der Blattschutz bei allen Blättern erst vor dem Ausführen aufgehoben und danach wieder eingeschaltet wird.
Leider wird dei Farbmarkierung auch mit ausgedruckt. Das sollte so nicht sein. Hast du evtl. eine "Before print" Idee.
Option Explicit


Private Sub Workbook_Open()
Dim wks As Worksheet
For Each wks In Worksheets
Select Case wks.Name
Case "Jahr Eingabe", "Feiertage" '--Ausnahmen
Case Else
wks.Range("A5:H35").Interior.ColorIndex = 0
End Select
Next
With ThisWorkbook.Sheets(Format(Date, "MMM"))
.Activate
With .Cells(Day(Date) + 4, 3)
.Select
.Offset(0, 0).Resize(1, 8).Interior.Color = RGB(204, 255, 204) '--Farbe A bis H
End With
End With
End Sub


Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Sh.Range("A5:H35").Interior.ColorIndex = 0
End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim rng1 As Range, rng2 As Range
Application.ScreenUpdating = False
With Target
'           Sh.Cells.Interior.ColorIndex = 0
Set rng1 = Intersect(Range("A5:H35"), Target.EntireRow)
If Not rng1 Is Nothing Then rng1.Interior.Color = RGB(204, 255, 204)
' Set rng2 = Intersect(Range("C5:M35"), Target.EntireColumn)
' If Not rng2 Is Nothing Then rng2.Interior.Color = RGB(255, 255, 197)
End With
Application.ScreenUpdating = True
Set rng1 = Nothing
' Set rng2 = Nothing
End Sub

LG
mike49

Select Case wks.Name Case "Jahr Eingabe", "Feiertage" '--Ausnahmen Case Else wks.Protect Password:="Kennwort", userinterfaceonly:=True '--Kennwort anpassen wks.Cells.Interior.ColorIndex = 0 End Select

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Dim rng1 As Range, rng2 As Range Application.ScreenUpdating = False With Target ' Sh.Cells.Interior.ColorIndex = 0

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) ActiveSheet.Unprotect '--bei Zellwechsel wird Schutz aufgehoben Dim r As Long Dim c As Integer If Not Intersect(Target, Range("B5:H35")) Is Nothing Then 'hier die Pruefung Range("B5:H35").Interior.ColorIndex = xlNone r = Selection.Row ' c = Selection.Column Range(Cells(r, 2), Cells(r, 8)).Interior.ColorIndex = 35 ' Range(Cells(2, c), Cells(8, c)).Interior.ColorIndex = 35 ActiveSheet.Protect '--Schutz setzen wenn Zellwechsel innerhalb der Range End If End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) 'ActiveSheet.Unprotect '--bei Zellwechsel wird Schutz aufgehoben Dim r As Long Dim c As Integer If Not Intersect(Target, Range("B5:H35")) Is Nothing Then 'hier die Pruefung ActiveSheet.Unprotect '--bei Zellwechsel wird Schutz aufgehoben Range("B5:H35").Interior.ColorIndex = xlNone r = Selection.Row ' c = Selection.Column Range(Cells(r, 2), Cells(r, 8)).Interior.ColorIndex = 35 ' Range(Cells(2, c), Cells(8, c)).Interior.ColorIndex = 35 ActiveSheet.Protect '--Schutz setzen wenn Zellwechsel innerhalb der Range ActiveSheet.EnableSelection = xlUnlockedCells '--gesperrte Zellen werden nicht angewählt End If End Sub

Beliebteste Forumthreads (12 Monate)

33 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

33
Beiträge zum Forumthread

Beiträge zu diesem Forumthread