Problem mit comments ...

Hallo Community,
bin völlig verzweifelt, da Fehler "Laufzeitfehler 438, Objekt unterstützt Eigenschaften ... nicht" nicht nachvollziehbar angeigt werden:
For i = 0 To 1
For j = 0 To 1
If Worksheets("komm").Cells(tg + i + 5, 102 + j + c1) <> "" Then
kmt = Worksheets("komm").Cells(tg + i + 5, 102 + j + c1)

If Not Cells(12, ((i + c1) * 3) + j + 24) Is Nothing Then
Cells(12, ((i + c1) * 3) + j + 24).ClearComments
End If
Cells(12, ((i + c1) * 3) + j + 24).ClearComments
Cells(12, ((i + c1) * 3) + j + 24).AddComment
Cells(12, ((i + c1) * 3) + j + 24).Comment = kmt
Cells(12, ((i + c1) * 3) + j + 24).Interior.ColorIndex = 6
Cells(12, ((i + c1) * 3) + j + 24).Value = "!"

Else

Cells(12, ((i + c1) * 3) + j + 24).Interior.ColorIndex = 0
Cells(12, ((i + c1) * 3) + j + 24).Value = ""
Cells(12, ((i + c1) * 3) + j + 24).ClearComments

End If
Next j
Next i

Wenn mir jemand sagen würde, wo mein Code unsauber oder fehlerhaft ist, wäre ich dankbar ...

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hier mein komplettes Sub. Es stellt einen Wochendienstplan für bis zu 20 Mitarbeiter dar, liest aus einer Matrix (Tabelle 365 Tage *100 MA) den individuellen Dienst für einen MA und stellt diesen farbig dar (Zellfarbe). Zudem holt er sich auch einer zweiten Matrix Kommentare für diese Zelle und schreibt sie in die angewählte Woche. Der (Wochen)Sprung erfolgt über einen Spinbutton ...
Private Sub SpinButton1_Change()
Rem neue woche darstellen
Dim kmt, a, b, c As String
Dim tg, i, j, f, s, n, lt, ln, kw As Integer
Dim kmt2 As Comment
Rem kw zwischen 1 und 52
kw = Cells(2, 8)
If kw > 52 Then
kw = 1
Cells(2, 8) = kw
End If
If kw < 1 Then
kw = 52
Cells(2, 8) = kw
End If

Rem übersicht löschen
ActiveSheet.Range("d12:ab41").ClearContents
Rem plan schreiben
Rem kw = Worksheets("planung").Cells(7, 6)
Rem Worksheets("übersicht").Cells(2, 8) = kw
tg = Worksheets("übersicht").Cells(4, 5)
so = 10
Rem korrektur kalenderwoche
c1 = 0
If Year(Worksheets("übersicht").Cells(7, 4)) = "2003" Then
For i = 0 To 6
If Year(Worksheets("übersicht").Cells(7, 4 + i * 4)) = "2003" Then c1 = c1 + 1
Next i
tg = 1
End If
Rem wochen-leiste lesen/schreiben
Rem mo-fr
For i = 0 To 4 - c1
For j = 0 To 3
dst = Worksheets("matrix").Cells(tg + i, 102 + j)
a = Left(dst, 1)
b = Mid(dst, 3, 2)
If b <> "" Then
If b = "10" Then Worksheets("übersicht").Cells(10, 4 + ((i + c1) * 4)) = "DA " & a
If b = "11" Then Worksheets("übersicht").Cells(10, 5 + ((i + c1) * 4)) = "DA " & a
If b = "12" Then Worksheets("übersicht").Cells(10, 6 + ((i + c1) * 4)) = "DA " & a
End If
Next j
Next i
Rem sa-so da-leiste
For i = 0 To 1
For j = 0 To 3
dst = Worksheets("matrix").Cells(tg + i + 5, 102 + j)
a = Left(dst, 1)
b = Mid(dst, 3, 2)
If b <> "" Then
If b = "13" Then Worksheets("übersicht").Cells(10, 24 + ((i + c1) * 3)) = "DA " & a
If b = "14" Then Worksheets("übersicht").Cells(10, 25 + ((i + c1) * 3)) = "DA " & a
End If
Next j
Next i

Rem error
Rem kommentar lesen und schreiben
For i = 0 To 4 - c1
For j = 0 To 2
If Worksheets("komm").Cells(tg + i, 102 + j + c1) <> "" Then
kmt = Worksheets("komm").Cells(tg + i, 102 + j + c1)

If Not Cells(12, ((i + c1) * 4) + j + 4) Is Nothing Then
Cells(12, ((i + c1) * 4) + j + 4).ClearComments

End If

Cells(12, ((i + c1) * 4) + j + 4).Interior.ColorIndex = 6
Cells(12, ((i + c1) * 4) + j + 4).Value = "!"

Cells(12, ((i + c1) * 4) + j + 4).AddComment
Cells(12, ((i + c1) * 4) + j + 4).Comment.Text = kmt
Stop
Else

Cells(12, ((i + c1) * 4) + j + 4).Interior.ColorIndex = 0
Cells(12, ((i + c1) * 4) + j + 4).Value = ""
Cells(12, ((i + c1) * 4) + j + 4).ClearComments

End If
Next j
Next i
Rem sa -so
For i = 0 To 1
For j = 0 To 1
If Worksheets("komm").Cells(tg + i + 5, 102 + j + c1) <> "" Then
kmt = Worksheets("komm").Cells(tg + i + 5, 102 + j + c1)

If Not Cells(12, ((i + c1) * 3) + j + 24) Is Nothing Then
Cells(12, ((i + c1) * 3) + j + 24).ClearComments
End If
Cells(12, ((i + c1) * 3) + j + 24).ClearComments
Cells(12, ((i + c1) * 3) + j + 24).AddComment
Cells(12, ((i + c1) * 3) + j + 24).Comment = kmt
Cells(12, ((i + c1) * 3) + j + 24).Interior.ColorIndex = 6
Cells(12, ((i + c1) * 3) + j + 24).Value = "!"

Else

Cells(12, ((i + c1) * 3) + j + 24).Interior.ColorIndex = 0
Cells(12, ((i + c1) * 3) + j + 24).Value = ""
Cells(12, ((i + c1) * 3) + j + 24).ClearComments

End If
Next j
Next i

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread