vor 2 tagen habe ich aus dem internet 'ne applikation, ein kalender bekommen.ein tolles tool.
die geplanten termine werden als "T " ausgegeben
zb: cells(z, r) = "T"
fuer meine beduerfnisse ist die buchstabe "T" ungeeignet.
ich brauche wegen der uebersicht hintergrundfarbe.zum einsatz
kommen ca. 13 verschiedene hintergrundfarben.ich habe zwar mit
cells(z, r).colorindex = 3 'rot als beispiel
versucht bekomme aber immer wieder 'ne fehlermeldung.
kann mir jemand weiter helfen? ich bedanke mich im voraus.
marc :-}}
' KALENDER KALENDER KALENDER
Private Sub cmdEinfuegen_Click()
Dim dat As Date, dat2 As Date, dat3 As Date
dat = Me.txtVon
dat2 = Me.txtBis
Worksheets(1).Activate
If dat2 > Cells(3, 182) And dat < Cells(3, 182) Then
dat3 = dat2
dat2 = Cells(3, 182)
End If
If dat > Cells(3, 182) Then Worksheets(2).Activate
sp = 1
Do While Cells(3, sp) <> dat
sp = sp + 1
Loop
sp2 = 1
Do While Cells(3, sp2) <> dat2
sp2 = sp2 + 1
Loop
z = 4
Do While Cells(z, 1) <> Me.cboEingabe
z = z + 1
Loop
If dat3 > 0 Then GoTo Seitenwechsel
For r = sp To sp2
Cells(3, r).Select
If Format(Cells(3, r), "ddd") = "Sa" _
Or Cells(2000, r) = 2 _
Or Format(Cells(3, r), "ddd") = "So" Then GoTo sprung
Cells(z, r) = "T" //.colorindex = 3 als beispiel
ut = ut + 1 // ist nicht moeglich !
txtInfo = "Es werden " & ut & " Tage" & Chr(13) & "benötigt"
sprung:
Next r
Exit Sub
Seitenwechsel:
For r = sp To sp2
Cells(3, r).Select
If Format(Cells(3, r), "ddd") = "Sa" _
Or Format(Cells(3, r), "ddd") = "So" Then GoTo sprung1
Cells(z, r) = "T"
ut2 = ut2 + 1
sprung1:
Next r
Worksheets(2).Activate
sp3 = 2
Do While Cells(3, sp3) <> dat3
sp3 = sp3 + 1
Loop
For s = 2 To sp3
Cells(3, s).Select
If Format(Cells(3, s), "ddd") = "Sa" _
Or Format(Cells(3, s), "ddd") = "So" Then GoTo sprung2
Cells(z, s) = "T"
ut2 = ut2 + 1
txtInfo = "Es werden " & ut2 & " Tage" & Chr(13) & "benötigt"
sprung2:
Next s
End Sub
Private Sub cmdOK_Click()
z = 5
Worksheets(2).Activate
loeschen:
Do While Cells(z, 1) <> ""
z = z + 1
Loop
Range("B5", "FZ" & z).Select
Selection.ClearContents
If l < 1 Then
Worksheets(1).Activate
l = 1
GoTo loeschen
End If
Cells(5, 2).Select
frmEintragLoesch.Hide
End Sub
Private Sub cmdNo_Click()
frmEintragLoesch.Hide
End Sub