habe hier ein kleines Progrämmchen mit ner Schleife.
Es wird ein Textfile geladen, in welchem Infos folgender Art drin sind, z. Bsp
L2
text text text
text text text
L2
text text
text text text
text text
L2
.
.
usw.
Am Anfang wir Header und so gemacht, dann geht
diese Schleife jetzt Zeile für Zeile durch, und wenn L2 kommt, dann soll er ne blaue Linie machen, oder immer die erste Textzeile soll fett sein, und er soll auch bei Bedarf nen Pagebreak machen (über HoeheIni). Nun braucht das Ding aber für 2500 Zeilen um die 2 Minuten, viiiel zu lahm. Seht ihr da noch irgendwelche Möglichkeiten?? Das ganze läuft asu ASP!
set excel = CreateObject("Excel.Application")
' ########### Open the downloaded text file #########
set xlbook = excel.Workbooks.Open(downpath)
Set ex = xlBook.ActiveSheet
Set ps = ex.PageSetup
'########### Makes the Page setup: headers ( Voith + title of the subject) ####
ps.LeftHeader = "&""Arial Black,Fett""&21Meine Firma"
ps.RightFooter = _
"&""Arial Black,Fett""&21VOITH" & Chr(10) & "&""Arial,Standard""&6Meine Firma"
ps.CenterFooter = "Page &P"
ps.Orientation = 2 '2 = xlLandscape => page orientated horizontaly
excel.Columns("A:E").Select
excel.Selection.HorizontalAlignment = -4131 'Alignment on the left of each cell
ex.Rows("1").Insert
ex.Range("A1:E1").Interior.ColorIndex = 5
ex.Rows("1:1").RowHeight = 2
ex.Rows("2").Font.Bold = True
ex.Rows("2:3").RowHeight = 12.75
ex.Rows("4").Insert
ex.Range("A4:E4").Interior.ColorIndex = 5
ex.Rows("4:4").RowHeight = 2
ex.Rows("5").Font.Bold = True
ex.Columns("A:E").WrapText = True
ex.Columns("B:B").EntireColumn.NumberFormat = "yyyy-mm-dd"
ex.Columns("A:E").ColumnWidth = 22
HoeheIni = 28.5 'HöheIni height after the title on the top of each page(2*12.75+2*2)
Hoehe = HoeheIni 'Höhe = Height of the actual cell in the page
HoeheLimit = 440 'HöheLimit = Limit height to make a page break
Offset = 5
TotalRows = ex.UsedRange.Rows.Count ' Get the total number of rows used
'########################## Here starts the insertion of the blue lines, the fat rows ################
Do While Offset <= TotalRows <------- HIER DIE SCHLEIFE
If ex.Range("A" & Offset).Value = "L1" Then 'if there is "L1" then...
ex.Rows(Offset).ClearContents 'he deletes the contents of the row...
ex.Range("A" & Offset & ":E" & Offset).Interior.ColorIndex = 5 'and put instead a blue line.
ex.Rows(Offset).RowHeight = 0.75
'if the active range is under a certain level of the page then hw makes a page break
If Hoehe > HoeheLimit Then
Offset = Offset + 1
With xlBook.ActiveSheet
.HPageBreaks.Add .Range("A" & Offset)
End With
ex.Rows(Offset).Insert 'here we insert 4 new rows to paste the headings (title... on each page)
ex.Rows(Offset).Insert
ex.Rows(Offset).Insert
ex.Rows(Offset).Insert
ex.Rows("1:4").Copy
ex.Rows(Offset).Select
xlBook.ActiveSheet.Paste
Hoehe = HoeheIni 'Initialise the height for the new page
Offset = Offset + 3
TotalRows = TotalRows + 4
ex.Rows(Offset+1).Font.Bold = True
Else
ex.Rows(Offset+1).Font.Bold = True
End If
Else
ex.Rows(Offset).EntireRow.AutoFit
End If
ZeileHoehe = ex.Rows(Offset).RowHeight
Hoehe = Hoehe + ZeileHoehe
Offset = Offset + 1
Loop
excel.ActiveWorkbook.SaveAs(ExcelCreatedPfad), FileFormat=xlNormal
xlbook.Close
excel.Quit
set ps = nothing
Set ex = Nothing
set xlbook = Nothing
set excel = Nothing
Set zeit = Nothing
Set fso = Nothing