AW: Makro läuft nicht unter Office 97
04.08.2003 16:16:30
Michael
Anbei das Makro,
dieses holt sich aus einem Tabellenblatt relevante Projektdaten und zeigt diese dann in einer Übersicht an, wobei der Zeitraum als farbiger Balken (von KW bis KW) angezeigt wird. Vielleicht ein bischen umständlich geschrieben aber es funktioniert, leider nur unter Office 2000. Ich kann nicht erkennen, welcher Befehl sich nicht mit Office 97 verträgt. Dort erscheint beim ersten Do Durchlauf ein Überlauffehler, weil die Variable i den Wert 256 hat, obwohl sie vorher auf Null gesetzt wird.
Jemand einen Rat??
Sub übersicht()
Dim i As Integer
Dim tabelle As String
Dim start As Date
Dim ende As Date
Dim farbe As Integer
Dim az As Integer
Dim projekte As Integer
az = Sheets("Projektübersicht").Range("A3").CurrentRegion.Rows.Count
If az > 4 Then
Range(Cells(5, 1), Cells(az, 30)).Select
Selection.Delete shift:=xlUp
End If
projekte = Sheets("Start").Range("A1").CurrentRegion.Rows.Count
For p = 2 To projekte
i = Sheets("Start").Cells(p, 1).Value
tabelle = "Projekt" & i
Projektnummer = Sheets(tabelle).Cells(2, 1).Value
Projektleiter = Sheets(tabelle).Cells(2, 3).Value
start = Sheets(tabelle).Cells(2, 4).Value
ende = Sheets(tabelle).Cells(2, 5).Value
farbe = Sheets(tabelle).Cells(2, 6).Interior.ColorIndex
Sheets("Projektübersicht").Cells(2 + p, 1).Interior.ColorIndex = farbe
Sheets("Projektübersicht").Cells(2 + p, 1).Value = Projektnummer
Sheets("Projektübersicht").Cells(2 + p, 2).Value = Projektleiter
Sheets("Projektübersicht").Cells(2 + p, 3).Value = start
Sheets("Projektübersicht").Cells(2 + p, 4).Value = ende
Sheets("Projektübersicht").Select
Range(Cells(4, 6), Cells(4, 30)).Copy
Cells(p + 2, 6).PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
farbe = Cells(p + 2, 1).Interior.ColorIndex
i = 0
Do
Cells(p + 2, 5 + i).Select
i = i + 1
On Error GoTo fehler
Loop Until Selection.Value <> Empty
j = i
i = 0
Do
Cells(p + 2, 5 + j + i).Select
i = i + 1
Loop Until Selection.Value <> Empty
k = i
Range(Cells(p + 2, 6), Cells(p + 2, 29)).Select
Selection.Font.ColorIndex = farbe
Selection.Interior.ColorIndex = 2
Range(Cells(p + 2, 4 + j), Cells(p + 2, 4 + j + k)).Select
Selection.Interior.ColorIndex = farbe
Next p
Exit Sub
fehler: MsgBox ("Bitte Projektdetails prüfen")
Sheets("Start").Select
End Sub