extra spm. til uge 53

Her kan du bruge betinget formatering. Marker området med datoerne. Vælg Formater - Betinget formatering. Angiv Celleværdien er. Lig med: =Idag(). Og vælg så blå farve,

>jkrons, det fungerer ikke !

Er det i min kalender du mener, så kræves lidt mere, her er en makro.

Const iInternational As Integer = Not (0)

Sub FindDag()
Md = Array("", "Januar", "Febuar", "Marts", "April", "Maj", "Juni", "Juli", "August", "September", "Oktober", "November", "December")
For Each C In Range("A2:R2,A34:R34").Cells
If C.Value = Md(Month(Date)) Then
GoTo Dag
Exit For
End If
Next

Dag:
For Each d In Range(C.Offset(1, -1).Address & ":" & C.Offset(31, -1).Address).Cells
If d.Value = Day(Date) Then
Range(d.Offset(0, -1).Address & ":" & d.Offset(0, 1).Address).Select
Exit For
End If
Next

Cells.FormatConditions.Delete

    Selection.FormatConditions.Add Type:=2, Formula1:=iInternational
    Selection.FormatConditions(1).Interior.ColorIndex = 41
End Sub

>kabbak, Ja det er din utrolige fine kalender ! Hvor skal jeg placerer denne makro?

I kalender arkets modul



Const iInternational As Integer = Not (0)

Private Sub Worksheet_Activate()
Md = Array("", "Januar", "Febuar", "Marts", "April", "Maj", "Juni", "Juli", "August", "September", "Oktober", "November", "December")
For Each C In Range("A2:R2,A34:R34").Cells
If C.Value = Md(Month(Date)) Then
GoTo Dag
Exit For
End If
Next

Dag:
For Each d In Range(C.Offset(1, -1).Address & ":" & C.Offset(31, -1).Address).Cells
If d.Value = Day(Date) Then
Range(d.Offset(0, -1).Address & ":" & d.Offset(0, 1).Address).Select
Exit For
End If
Next

Cells.FormatConditions.Delete

    Selection.FormatConditions.Add Type:=2, Formula1:=iInternational
    Selection.FormatConditions(1).Interior.ColorIndex = 41
End Sub

>kabbak, Jeg smed den i thisworkbook, "workbook open" og det fungerer også.

smider du et svar

>kabbak, hvad nu hvis det kun er kolonnerne med dag- og dato betgnelsen, der skal markeres. kan det lade sig gøre ?

Range(d.Offset(0, -1).Address & ":" & d.Offset(0,0).Address).Select

Range(d.Offset(0, -1).Address & ":" & d.Address).Select

sådan

tak for point

tak for hjælpen