Re: Nochmal Fehler 1004
17.01.2003 18:18:41
RoDiMa
Hallo Nepomuk,
Du hast Dich schon mal mit der Angelegenheit beschäftigt.
Leider war es eine Fehlinfo von mir, als ich Dir mitteilte, daß jetzt alles läuft. Hier also der Code der unter XP einwandfrei läuft. Kann es vielleicht auch an fehlenden Verweisen liegen?
Dim iZeile%, iSpalte%, LastCol%, iTag%, Blatt$
Private Sub CmbDateneintragen_Click()
Dim Vom As Date, Bis As Date, LbTag%, i%
Dim Blatt1 As Worksheet, BlattN As Worksheet, Blatt2 As Worksheet
Set Blatt1 = Worksheets(Month(TbVom) + 1)
Set Blatt2 = Worksheets(Month(TbBis) + 1)
iZeile = Blatt1.Columns(1).Find(ComboMA).Row *****hier passiert's***
If Month(TbVom) <> Month(TbBis) Then
iSpalte = Day(TbVom) + 1
LastCol = Blatt1.Cells(2, Columns.Count).End(xlToLeft).Column
Farbe (Blatt1.Name)
i = 1
Do Until Blatt1.Index + i = Blatt2.Index
Set BlattN = Worksheets(Blatt1.Index + i)
iSpalte = 2
LastCol = BlattN.Cells(2, Columns.Count).End(xlToLeft).Column
Farbe (BlattN.Name)
i = i + 1
Loop
iSpalte = 2
LastCol = Day(TbBis) + 1
Farbe (Blatt2.Name)
Else
iSpalte = Day(TbVom) + 1
LastCol = Day(TbBis) + 1
Farbe (Blatt1.Name)
End If
End Sub
Sub Farbe(Blatt)
For iSpalte = iSpalte To LastCol
iTag = Weekday(Worksheets(Blatt).Cells(2, iSpalte), vbMonday)
If Worksheets(Blatt).Cells(100, iSpalte) <> 2 Then
If iTag = LbTage.ListIndex Or LbTage.ListIndex = 0 Then
If ComboArt = "LÖSCHEN" Then
Worksheets(Blatt).Cells(iZeile, iSpalte) = ""
Else
Worksheets(Blatt).Cells(iZeile, iSpalte) = ComboArt
With Worksheets(Blatt).Cells(iZeile, iSpalte).Font
.Bold = True
Select Case ComboArt
Case "U"
.ColorIndex = 10
Case "K"
.ColorIndex = 3
Case "aA"
.ColorIndex = 43
Case "AA"
.ColorIndex = 32
Case "AD"
.ColorIndex = 51
Case "SU"
.ColorIndex = 14
Case "DR"
.ColorIndex = 41
Case "DG"
.ColorIndex = 20
Case Else
.ColorIndex = 1
End Select
End With
End If
End If
End If
Next
End Sub