auxmoney - Geld leihen für das Studiumauxmoney - Geld leihen für das Studium

auxmoney - Geld leihen für den Umzugauxmoney - Geld leihen für den Umzug

Drucken mit Excel

Drucken mit Excel: 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  

Mehr Tipps: VBA-Handling in der Entwicklungsumgebung

Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt