| PrintArea, PrintOut, PrintPreview, PageSetup | |
| | |
| | |
| Drucke alle Workbooks (incl. Sheets) eines | Sub DruckeAlles() | |
| Verzeichnisses | Dim datei As String | |
| datei = Dir("E:\MeineDateien\*.xls") | Pfad und Dateiendung. |
| Application.EnableEvents = False | Fehlermeldungen unterdrücken. |
| While datei <> "" | |
| Workbooks.Open ("E:\MeineDateien\" & datei) | Eine Datei nach der anderen öffnen. |
| Workbooks(datei).PrintOut | Drucke alle Sheets. |
| Workbooks(datei).Close savechanges:=False | Datei schließen. |
| datei = Dir() | Nächste Datei ermitteln. |
| Wend | |
| Application.EnableEvents = True | |
| | End Sub | |
| Druckbereich festlegen (aktive bis letzte | Sub DruckbereichFestlegen() | |
| verwendete Zelle) | Range(ActiveCell, ActiveCell.End(xlDown)).Select | |
| ActiveSheet.PageSetup.PrintArea = _ | |
| ActiveCell.CurrentRegion.Address | |
| | End Sub | |
| Seite drucken, in der sich der Cursor | Dim zb%, sb%, i%, j%, y%, z%, intZ%, intS% | |
| befindet (3 Routinen !) | Dim eSeite As Boolean, aSeite As Boolean | |
| Sub SeiteDruckenCursor() | |
| Application.ScreenUpdating = False | |
| ActiveSheet.PageSetup.PrintArea = "" | |
| y = 1: z = 1: i = 1: j = 1 | |
| eSeite = False: aSeite = False | |
| Do While aSeite = False | |
| Call zeilen | |
| Loop | |
| End Sub | |
| Private Sub zeilen() | |
| Dim blatt As Range, pruefen As Object | |
| Do While eSeite = False | |
| Call SUmbruch(i, j) | |
| Set blatt = Range(Cells(y, z), Cells(zb, sb)) | |
| Set pruefen = Application.Intersect(Range(ActiveCell.Address), _ |
| Range(blatt.Address)) | |
| If pruefen Is Nothing = False Then | |
| ActiveSheet.PageSetup.PrintArea = blatt.Address | |
| ActiveSheet.PrintOut | |
| End | |
| End If | |
| y = zb + 1 | |
| i = i + 1 | |
| Loop | |
| j = j + 1 | |
| z = sb + 1 | |
| i = 1: y = 1 | |
| eSeite = False | |
| End Sub | |
| Sub SUmbruch(nBlatt, oBlatt) | |
| Dim varPB, nSeite% | |
| varPB = ExecuteExcel4Macro("Index(Get.Document(64), " _ |
| & nBlatt & ")") | |
| If IsError(varPB) Then | |
| zb = Cells(Cells.Rows.Count, oBlatt).End(xlUp).Row |
| eSeite = True | |
| Exit Sub | |
| End If | |
| zb = varPB - 1 | |
| varPB = ExecuteExcel4Macro("Index(Get.Document(65), " _ |
| & oBlatt & ")") | |
| If IsError(varPB) Then | |
| aSeite = True | |
| sb = Cells(nBlatt, 256).End(xlToLeft).Column | |
| Exit Sub | |
| End If | |
| sb = varPB - 1 | |
| | End Sub | |
| Umgekehrte Druckreihenfolge für ein | Sub Drucke_Seite_200_Bis_1() | |
| Worksheet | Dim i%, seite% | |
| seite = ExecuteExcel4Macro("Get.Document(50)") | |
| For i = seite To 1 Step -1 | |
| ActiveSheet.PrintOut From:=i, To:=i | |
| Next | |
| | End Sub | |
| Umgekehrte Druckreihenfolge für ein | Sub Drucke_Blatt_Z_Bis_A() | |
| Workbook | Dim i% | |
| For i = Sheets.Count To 1 Step -1 | |
| Sheets(i).PrintOut | |
| Next i | |
| | End Sub | |
| Umgekehrte Druckreihenfolge für Workbook | Sub Drucke_Alles_Rueckwaerts() | |
| und Worksheets | Dim i%, x%, seite% | |
| seite = ExecuteExcel4Macro("Get.Document(50)") | |
| For i = Sheets.Count To 1 Step -1 | |
| For x = seite To 1 Step -1 | |
| Sheets(i).PrintOut From:=x, To:=x | |
| Next x | |
| Next i | |
| | End Sub | |
| Zuerst Vorder-, dann Rückseitendruck | Sub DruckeVorderRueck() | |
| Dim i%, n%, nBlatt%, aZeile%, bZeile%, varPB | |
| Application.ScreenUpdating = False | |
| bZeile = Cells.Find("*", [a1], , , xlByRows, xlPrevious).Row |
| nBlatt = 1: aZeile = 1 | |
| For n = 1 To 2 | |
| For i = 1 To ExecuteExcel4Macro("GET.DOCUMENT(50)") |
| varPB = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64)," _ |
| & nBlatt & ") ") | |
| If IsError(varPB) Then varPB = bZeile + 1 | |
| If n = 1 And nBlatt Mod 2 <> 0 Or _ | |
| n = 2 And nBlatt Mod 2 = 0 Then | |
| Range(Cells(aZeile, "A"), Cells(varPB - 1, "E")).PrintPreview |
| End If | |
| nBlatt = nBlatt + 1 | |
| aZeile = varPB | |
| Next i | |
| nBlatt = 1: aZeile = 1 | |
| If n = 1 Then MsgBox "Bitte Blätter einlegen." | |
| Next n | |
| [a1].Select | |
| | End Sub | |
| Nur ausgewählte Dateien eines | Sub Drucke_Auswahl_von_Dateien_eines_Verzeichnisses() |
| Verzeichnisses drucken | Dim dateien, d | |
| dateien = Application.GetOpenFilename(FileFilter:= _ |
| "Microsoft Excel-Dateien (*.xls), *.xls", Title:="Alle _ |
| auszudruckenden Dateien markieren", MultiSelect:=True) |
| If IsArray(dateien) = False Then | |
| If dateien = False Then Exit Sub | |
| End If | |
| For d = 1 To UBound(dateien) | |
| Workbooks.Open Filename:=dateien(d) | |
| ActiveWorkbook.PrintOut | |
| ActiveWorkbook.Close SaveChanges:=False | |
| Next | |
| | End Sub | |
| Kopfzeile abwechselnd links oder rechts | Sub KopfzeileAbwechselndLinksOderRechtsDrucken() | |
| drucken | Dim PageCount%, x%, y As Boolean | |
| y = True | |
| x = ExecuteExcel4Macro("Get.Document(50)") | |
| For PageCount = 1 To x | |
| If y = True Then | |
| With ActiveSheet.PageSetup | |
| .LeftHeader = "Name" | |
| .RightHeader = "" | |
| End With | |
| End If | |
| If y = False Then | |
| With ActiveSheet.PageSetup | |
| .LeftHeader = "" | |
| .RightHeader = "Text" | |
| End With | |
| End If | |
| ActiveWindow.SelectedSheets.PrintOut From:=PageCount, _ |
| To:=PageCount, Copies:=1 | |
| y = Not y | |
| Next PageCount | |
| | End Sub | |
| Erste Druckseite in neue Mappe kopieren | Sub ErsteDruckseiteInNeueMappeKopieren() | |
| Dim r As Range, IR%, IC%, CO% | |
| Application.ScreenUpdating = False | |
| IR = ExecuteExcel4Macro("Index(Get.Document(64),1)") - 1 |
| IC = ExecuteExcel4Macro("Index(Get.Document(65),1)") - 1 |
| Set r = Range(Cells(1, 1), Cells(IR, IC)) | |
| Workbooks.Add | |
| r.Copy Range("a1") | |
| For CO = 1 To r.Columns.Count | |
| Columns(CO).ColumnWidth = r.Columns.ColumnWidth |
| Next CO | |
| For CO = 1 To r.Rows.Count | |
| Rows(CO).RowHeight = r.Rows.RowHeight | |
| Next CO | |
| | End Sub | |
| Druckt ausgewählte Dateien; Mehrfach- | Sub Drucken2(arr) | Drei Routinen kommen in ein Modul. |
| Auswahl über ListBox | Application.ScreenUpdating = False | |
| On Error GoTo end3 | |
| Dim i% |
| For i = UBound(arr) To 1 Step -1 |
| Workbooks(arr(i)).Activate |
| Call print_out |
| Next i |
| Workbooks(mk).Activate |
| end3: Exit Sub |
| End Sub |
| Sub print_out() |
| For i2 = Sheets.Count To 1 Step -1 |
| Sheets(i2).PrintOut |
| Next i2 | |
| End Sub | |
| Sub Start() | |
| frmDrucken.Show | Laden des Formulars. |
| End Sub | |
| Sub cmdFileprint_Click() | Drei Routinen kommen ins Formular. |
| Dim arrWks(), i%, i2% | |
| For i = 0 To lstDrucken.ListCount - 1 | Druck starten. |
| If lstDrucken.Selected(i) Then | |
| i2 = i2 + 1 | |
| ReDim Preserve arrWks(1 To i2) | |
| arrWks(i2) = lstDrucken.List(i) | |
| End If | |
| Next i | |
| Unload Me | |
| Call Drucken2(arrWks) | |
| End Sub | |
| Sub UserForm_Initialize() | Laden der ListBox (Nur Dateien, die |
| Dim wb As Workbook | sich im aktuellen Verzeichnis dieses |
| lstDrucken.Clear | Programms befinden ! |
| For Each wb In Workbooks | |
| lstDrucken.AddItem wb.Name | |
| Next wb | |
| End Sub | |
| Sub cmdAbbrechen_Click() | Entladen des Formulars. |
| Unload Me | |
| End Sub | |
| Sub Drucken_Click() | Diese Routine wird aus dem Excel- |
| frmDrucken.Caption = "Druckmenü" | Worksheet aufgerufen, auf dem sich |
| Application.Run mk + "!Start" | ein Drucken-Startbutton befindet. |
| | End Sub | |
| Anzahl der Druckseiten ermitteln | Sub SeitenzahlDerAktivenTabelleErmitteln() | |
| Dim i As Integer | |
| i = ExecuteExcel4Macro("Get.Document(50)") | |
| MsgBox "Anzahl der Seiten = " & i | |
| | End Sub | |
| Tabelle nur drucken, wenn Anzahl der | Function SZ() | |
| Druckseiten = 1 ist | Dim i As Integer | |
| i = ExecuteExcel4Macro("Get.Document(50)") | |
| SZ = i | |
| End Function | |
| Sub Abfrage() | |
| If SZ = 1 Then | |
| ActiveWindow.SelectedSheets.PrintOut | |
| Else | |
| MsgBox "Zuviele Druckseiten!" | |
| Exit Sub | |
| End If | |
| | End Sub | |
| Alle Druckseiten einer Arbeitsmappe zählen | Sub SeitenzahlErmitteln() | |
| Dim i As Integer | |
| Dim Blatt As Worksheet | |
| i = 0 | |
| For Each Blatt In ActiveWorkbook.Sheets | |
| Blatt.Activate | |
| Seiten = ExecuteExcel4Macro("Get.Document(50)") | |
| i = i + Seiten | |
| Next Blatt | |
| MsgBox "Anzahl der Seiten = " & i | |
| | End Sub | |
| Nur letzte Seite eines Worksheets drucken | Sub PrintLastSite() | |
| Dim iSite As Integer | |
| iSite = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(50),1)") |
| ActiveSheet.PrintOut from:=iSite, to:=iSite | |
| | End Sub | |
| Druckt "Report" mit Kopfzeile | Sub Printr() | |
| ActiveSheet.PageSetup.CenterHeader = _ | Kopfzeile zentriert (Arial fett kursiv) |
| "&""Arial,Bold Italic""&14My Report" _ | Kopfzeilentitel: My Report |
| & Chr(13) & Sheets(1).Range("A1") | zweite Zeile: Inhalt der Zelle A1 von |
| ActiveWindow.SelectedSheets.PrintOut Copies:=1 | Blatt 1 |
| | End Sub | |
| Hoch- oder Querformat kontrollieren | Sub PrintRpt1() | |
| Sheets(1).PageSetup.Orientation = xlLandscape | xlLandscape = horizontal |
| Range("Report").PrintOut Copies:=1 | xlPortrait = vertikal |
| | End Sub | |
| Verschiedene Bereiche in einem Durchgang | Sub PrintRpt2() | |
| drucken | Range("HVIII_3A2").PrintOut | |
| Range("BVIII_3").PrintOut | |
| Range("BVIII_4A").PrintOut | |
| Range("HVIII_4A2").PrintOut | |
| Range("BVIII_5A").PrintOut | |
| Range("BVIII_5B2").PrintOut | |
| Range("HVIII_5A2").PrintOut | |
| Range("HVIII_5B2").PrintOut | |
| | End Sub | |
| Definierten Bereich drucken | Sub PrintRpt3() | |
| With ActiveSheet.PageSetup | |
| .CenterHorizontally = True | zentrierter Ausdruck |
| .PrintArea = "$A$3:$C$15" | Druckbereich |
| .PrintTitleRows = ("$A$1:$A$2") | Titel drucken aus Zellen A1 und A2 |
| .Orientation = xlPortrait | vertikaler Ausdruck |
| .FitToPagesWide = 1 | Bereich vergrößert / verkleinert auf |
| .FitToPagesTall = 1 | A4 anpassen |
| End With | |
| ActiveSheet.PrintOut | |
| | End Sub | |
| Druckbereich bis zum ersten Nullwert | Sub DruckBisNull() | |
| festlegen | Dim intRow% | |
| intRow = 1 | |
| Do Until Cells(intRow, 1) = 0 | |
| intRow = intRow + 1 | |
| Loop | |
| Tabelle1.PageSetup.PrintArea = ActiveSheet.Name & "!" & _ |
| Range Cells(1, 1), Cells(intRow - 1, 11)).Address | |
| ActiveSheet.PrintPreview | |
| | End Sub | |
| | |
zurück