Re: Arbeitsmappe in Excel 97 bearbeiten
14.07.2002 11:02:12
Judith
Das worksheets(3) hab ich schon weiter oben in der Funktion. In Xp hat er mir nen Fehler angezeigt bei .range da hab ich dann Tabelle3.range geschrieben und es hatte geklappt. (Habs jetzt wieder entfernt)
Hier ist mal die ganze Funktion:Function Tabelle()
Dim Art As String
Dim Sp As String
Dim K As String
Dim y As Integer
Dim y1 As Integer
Anzahl = Tabelle2.Zaehlen
B = 0
' Erstellen der Tabellen
Do While Anzahl > 1
Anzahl = Anzahl - 1
'x = x - 1
B = B + 1
z = 10 * B
y = 3 + z
y1 = 11 + z
D = 1
Zeilenbreite = 12 + z
L = Datum()
'Zellinhalte
With Worksheets(3)
' Übergane des Datum aus der Tabelle 1
.Cells(y, 3).Value = Tabelle1.Range("E6")
' Inhalte ab der 2ten Tabelle
.Cells(y, 1).Value = "Name"
.Cells(y, 2).Value = "Datum"
.Cells(y, 34).Value = "Ges.-Std."
.Cells(y + 1, 2).Value = "Dienstzeit"
.Cells(y + 2, 2).Value = "Anfang"
.Cells(y + 3, 2).Value = "Ende"
.Cells(y + 4, 2).Value = "Nachtstunden"
.Cells(y1 - 3, 2).Value = "Sonntag"
.Cells(y1 - 2, 2).Value = "Feiertag"
.Cells(y1 - 1, 2).Value = "Bereitschaft"
.Cells(y1, 2).Value = "Gesamt"
' Dickgedruckte Zellinhalte
.Range(.Cells(y, 1), .Cells(y, 34)).Font.Bold = True
.Cells(y1, 2).Font.Bold = True
.Cells(y, 34).Font.Bold = True
.Cells(y1, 2).Font.Bold = True
.Cells(y + 1, 2).Font.Bold = True
.Cells(y, 34).Font.Bold = True
' Schriftgröße
.Range(.Cells(y, 1), .Cells(y1, 34)).Font.Size = 12
.Range(.Cells(y + 2, 3), .Cells(y1, 33)).Font.Size = 9
.Range(.Cells(y + 2, 1), .Cells(y1, 2)).Font.Size = 10
'Rahmen mit Rahmenstärke
.Range(.Cells(y, 1), .Cells(y1, 1)).BorderAround Weight:=xlMedium
.Range(.Cells(y, 1), .Cells(y, 34)).BorderAround Weight:=xlMedium
.Range(.Cells(y, 1), .Cells(y1, 34)).BorderAround Weight:=xlMedium
.Cells(y + 1, 1).BorderAround Weight:=xlMedium
.Range(.Cells(y + 2, 2), .Cells(y + 2, 34)).BorderAround Weight:=xlThin
.Range(.Cells(y + 3, 2), .Cells(y + 3, 34)).BorderAround Weight:=xlThin
.Range(.Cells(y + 4, 2), .Cells(y + 4, 34)).BorderAround Weight:=xlThin
.Range(.Cells(y + 5, 2), .Cells(y + 5, 34)).BorderAround Weight:=xlThin
.Range(.Cells(y + 6, 2), .Cells(y + 6, 34)).BorderAround Weight:=xlThin
.Range(.Cells(y + 7, 2), .Cells(y + 7, 34)).BorderAround Weight:=xlThin
.Range(.Cells(y + 8, 2), .Cells(y + 8, 34)).BorderAround Weight:=xlThin
'Zeilenbreite
Tabelle3.Rows(Zeilenbreite).RowHeight = 30#
'Zellen verbinden
.Range(.Cells(y + 2, 1), .Cells(y1, 1)).Merge
.Range(.Cells(y + 2, 1), .Cells(y1, 1)).HorizontalAlignment = xlLeft
.Range(.Cells(y + 2, 1), .Cells(y1, 1)).VerticalAlignment = xlCenter
.Range(.Cells(y + 2, 1), .Cells(y1, 1)).WrapText = True
.Range(.Cells(y + 2, 1), .Cells(y1, 1)).Orientation = 0
.Range(.Cells(y + 2, 1), .Cells(y1, 1)).AddIndent = False
.Range(.Cells(y + 2, 1), .Cells(y1, 1)).IndentLevel = 0
.Range(.Cells(y + 2, 1), .Cells(y1, 1)).ShrinkToFit = False
.Range(.Cells(y + 2, 1), .Cells(y1, 1)).ReadingOrder = xlContext
.Range(.Cells(y + 1, 2), .Cells(y + 1, 34)).Merge
K = 1
Spalte = 2
Do While K < 33
.Range(.Cells(y + 2, Spalte + 1), .Cells(y + 8, Spalte + 1)).BorderAround Weight:=xlThin
.Cells(y, Spalte + 1).BorderAround Weight:=xlMedium
K = K + 1
Spalte = Spalte + 1
Loop
.Range(.Cells(y + 1, 2), .Cells(y + 1, 34)).BorderAround Weight:=xlMedium
.Range(.Cells(y1, 2), .Cells(y1, 2)).BorderAround Weight:=xlMedium
.Range(.Cells(y1, 34), .Cells(y1, 34)).BorderAround Weight:=xlMedium
'Formate der Zellen
.Range(.Cells(y, 3), .Cells(y, 34)).NumberFormat = "dd"
.Range(.Cells(y + 2, 3), .Cells(y + 3, 34)).NumberFormat = "[h]:mm"
.Range(.Cells(y + 4, 3), .Cells(y1, 34)).NumberFormat = "[h],mm"
'Datumzeile füllen
D = 1
Do While D < L
Tabelle3.Rows(y).RowHeight = 17#
Tabelle3.Rows(y + 1).RowHeight = 17#
Tabelle3.Cells(y, 3).Value = Tabelle1.Range("E6").Value
.Cells(y, 3 + D).Value = .Cells(y, 3 + D - 1).Value + 1
D = D + 1
Loop
Do While D < 31
Cells(y, 3 + D).Value = ""
D = D + 1
Loop
'Übergabe des Namen aus Tabelle 3 für die Erste Tabelle
Tabelle3.Range("A5").Value = Tabelle2.Range("A11").Value
x = Tabelle2.Zaehlen
'Übergabe der Namen für die Übrigen Tabellen
N = 1
AZ = 15: AZ2 = 12
For N = 1 To x - 1
Tabelle3.Range("A" + CStr(AZ)).Value = Tabelle2.Range("A" + CStr(AZ2))
AZ = AZ + 10
AZ2 = AZ2 + 1
Next N
End With
Loop
End Function