Herbers Excel/VBA-Archiv
Automatisiertes Drucken
- Automatisiertes Drucken von Nico vom 15.09.2004 16:04:33
- AW: Automatisiertes Drucken - von Udo am 15.09.2004 16:08:56
- AW: Automatisiertes Drucken - von Nico am 15.09.2004 16:13:10
 |
Betrifft: Automatisiertes Drucken
von: Nico
Geschrieben am: 15.09.2004 16:04:33
Hallo,
mit Hilfe des "Excel.Application"-Objektes wurde aus einer externen Anwendung heraus ein Excelsheet erstellt. Dieses soll nun im Querformat gedruckt werden. Leider lässt sich "pagesetup.orientation" nicht ändern ("Die Eigenschaft des Objekts kann nicht geändert wernde").
Kann mir da jemand helfen ?
Vielen Dank im Voraus,
Mfg
Nico
 |
Betrifft: AW: Automatisiertes Drucken von: Udo
Geschrieben am: 15.09.2004 16:08:56
Ohne Code wahrscheinlich nicht!
Udo
| |
Betrifft: AW: Automatisiertes Drucken von: Nico
Geschrieben am: 15.09.2004 16:13:10
Hier der Code, Danke !!!
Sub drucken(sender)
dim i
Dim xlApp
Dim xlWb
Dim xlWs
dim objRS
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Add
Set xlWs = xlWb.Worksheets("Tabelle1")
xlApp.Visible = True
xlApp.DisplayAlerts = True
xlws.pagesetup.Orientation = "msoTextOrientationHorizontal"
xlws.range("a1").value = "Antragsnummer"
xlws.range("b1").value = "Antragsnummer Erweiterung"
xlws.range("c1").value = "Kunde"
xlws.range("d1").value = "Vermittlernummer"
xlws.range("e1").value = "Antragsdatum"
xlws.range("f1").value = "Provisionsdatum"
xlws.range("g1").value = "Synch Datum"
xlws.range("h1").value = "Storno"
xlws.range("i1").value = "Beitrag Summe"
xlws.range("a1:i1").Font.Bold = True
set objRS = grdSRGDaten.recordset
I = 2
while not objRS.eof
xlWS.range("a" & i).value = objRS(1)
xlWS.range("b" & i).value = objRS(2)
xlWS.range("c" & i).value = objRS(3)
xlWS.range("d" & i).value = objRS(4)
xlWS.range("e" & i).value = objRS(5)
xlWs.range("e" & i).NumberFormat = "m/d/yyyy"
xlWS.range("f" & i).value = objRS(6)
xlWs.range("f" & i).NumberFormat = "m/d/yyyy"
xlWS.range("g" & i).value = objRS(7)
xlWs.range("g" & i).NumberFormat = "m/d/yyyy"
xlWS.range("h" & i).value = objRS(8)
xlWS.range("i" & i).value = objRS(9)
xlWs.range("i" & i).NumberFormat = "#,##0.00 $"
objRS.movenext
i = i +1
wend
set objRS = nothing
'now auto-fit the width of the columns
xlApp.Selection.CurrentRegion.Columns.AutoFit
'now print it
' xlWs.PrintOut
' xlApp.Quit
Set xlWs = Nothing
Set xlWb = Nothing
Set xlApp = Nothing
End Sub| |