AW: Makro um bestimmte Spalten zu drucken
05.08.2011 21:06:41
fcs
Hallo addi,
das Grundgerüst ist einfach. Blende in einer Schleife alle Spalten aus, die nicht gedruckt werden sollen und ermittle die max. Anzahl Zeilen in den sichtbaren Zeilen.
Druckbereich anpassen, Drucken - fertig.
Aber hier gibt es ja noch einiges an Zusatzaufgaben, die berücksichtigt werden müssen.
1. Standarddrucker in Windows ermitteln und ggf. zum aktiven Drucker machen
2. Aktuelle Einstellungen (Ansicht, Drucken etc) vor dem Drucken sichern (als benutzerdefinierte Ansicht)
3. Seite für das Drucken einrichten
3. Drucken
4. bemerkten aktiven Drucker wieder setzen und Einstellungen wieder herstellen.
Gruß
Franz
Option Explicit
'Quelle für Name des Windows-Standarddruckers
'http://spotlight-wissen.de/archiv/message/1186222.html
Private Declare Function GetProfileString Lib "kernel32" _
Alias "GetProfileStringA" (ByVal lpAppName As String, _
ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long) _
As Long
Private Sub GetStdPrinterName(PrinterName$, Driver$, Port$)
Dim Buffer$, r&, x&, y&
Buffer = Space(8192)
r = GetProfileString("windows", "Device", "", Buffer, Len(Buffer))
If r Then
Buffer = Mid(Buffer, 1, r)
x = InStr(Buffer, ",")
PrinterName = Mid(Buffer, 1, x - 1)
y = InStr(x + 1, Buffer, ",")
Driver = Mid(Buffer, x + 1, y - x - 1)
Port = Mid(Buffer, y + 1)
Else
PrinterName = ""
Driver = ""
Port = ""
End If
End Sub
Sub PrintMyColumns()
Dim wb As Workbook, wks As Worksheet, Spalte&, ZeileMax&, SpalteMax&
Dim sPrinter$, sPrinterAktiv$, PrinterName$, Driver$, Port$
Dim sMyPresentView$
Dim statusOrientation&
Set wb = ActiveWorkbook
'aktuelle Ansichtseinstellungen merken
sMyPresentView = "MeineAktuelleAnsicht"
wb.CustomViews.Add ViewName:="MeineAktuelleAnsicht", _
PrintSettings:=True, RowColSettings:=True
'Windows-Standarddrucker ermitteln
Call GetStdPrinterName(PrinterName, Driver, Port)
'MsgBox "Standarddrucker: " & vbLf & PrinterName & vbLf & Driver & vbLf & Port ' Testzeile
sPrinterAktiv = Application.ActivePrinter 'Aktiven Drucker merken
If UCase(Left(sPrinterAktiv, Len(PrinterName))) UCase(PrinterName) Then
'Trennwort zwischen Druckername und Port ermitteln
sPrinter = Left(sPrinterAktiv, InStrRev(sPrinterAktiv, " ") - 1)
sPrinter = Mid(sPrinter, InStrRev(sPrinter, " ", -1) + 1)
sPrinter = PrinterName & " " & sPrinter & " " & Port
Application.ActivePrinter = sPrinter
End If
Set wks = ActiveSheet
With wks
'Spalten ausblenden, die nicht gedruckt werden sollen, letzte Datenzeile in den _
zu druckenden Zeilen ermitteln
Application.ScreenUpdating = False
'Alle Spalten und Zeilen einblenden
.Columns.Hidden = False
.Rows.Hidden = False
SpalteMax = .Cells.SpecialCells(xlCellTypeLastCell).Column
For Spalte = 1 To SpalteMax
Select Case Spalte
Case 2, 3, 5 To 8, 12 To 15, 18, 22 'zu druckende Spalten
ZeileMax = Application.WorksheetFunction.Max(ZeileMax, _
.Cells(.Rows.Count, Spalte).End(xlUp).Row)
Case Else
.Columns(Spalte).Hidden = True
End Select
Next
With .PageSetup
'Seite Einrichten für Druckausgabe
.PrintArea = wks.Range(wks.Cells(1, 1), _
wks.Cells(ZeileMax, Spalte)).Address(ReferenceStyle:=xlA1)
statusOrientation = .Orientation
If .Orientation = xlPortrait Then
.Orientation = xlLandscape
End If
.LeftMargin = Application.CentimetersToPoints(1)
.RightMargin = Application.CentimetersToPoints(1)
.TopMargin = Application.CentimetersToPoints(1.8)
.HeaderMargin = Application.CentimetersToPoints(1.4)
.BottomMargin = Application.CentimetersToPoints(1)
.FooterMargin = Application.CentimetersToPoints(1)
'Drucken auf eine Seite
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
Application.ScreenUpdating = True
End With
.PrintOut Preview:=True, ActivePrinter:=sPrinter
End With
'Ansicht vor dem Drucken inkl. Druckeinstellungen wieder herstellen
wb.CustomViews(sMyPresentView).Show
wb.CustomViews(sMyPresentView).Delete
Application.ActivePrinter = sPrinterAktiv
End Sub