ich würde gerne in einer Userform die Kopfzeile (resp. Fußzeile) anzeigen lassen. Meine erste Idee war ein Bild, dass die aktuelle Konfiguration zeigt.
Hat jemand dazu Tipps? Oder vielleicht auch einen anderen Vorschlag?
Vielen Dank,
Fender
ClassModule: frmPrint
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdPrint_Click()
Application.ScreenUpdating = False
keybd_event VK_SNAPSHOT, 1, 0, 0
Workbooks.Add 1
ActiveSheet.Range("A1").Select
Application.Wait Now + TimeValue("00:00:01")
ActiveSheet.PasteSpecial _
Format:="Bitmap", _
Link:=False, _
DisplayAsIcon:=False
With ActiveSheet
.PageSetup.Orientation = xlLandscape
.PageSetup.LeftHeader = "Meine UserForm"
.PrintOut
End With
ActiveWorkbook.Close False
Application.ScreenUpdating = True
End Sub
StandardModule: Modul1
Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Public Const VK_SNAPSHOT = &H2C
Sub CallForm()
frmPrint.Show
End Sub
Private Sub UserForm_Initialize()
Dim L As String
Dim C As String
Dim R As String
Dim SN
L = ActiveSheet.PageSetup.LeftHeader
C = ActiveSheet.PageSetup.CenterHeader
R = ActiveSheet.PageSetup.RightHeader
If Left(L, 1) "&" Then
Label1.Caption = L
Else
Label1.Caption = Var(L)
End If
If Left(C, 1) "&" Then
Label2.Caption = C
Else
Label2.Caption = Var(C)
End If
If Left(R, 1) "&" Then
Label3.Caption = R
Else
Label3.Caption = Var(R)
End If
L = ActiveSheet.PageSetup.LeftFooter
C = ActiveSheet.PageSetup.CenterFooter
R = ActiveSheet.PageSetup.RightFooter
If Left(L, 1) "&" Then
Label4.Caption = L
Else
Label4.Caption = Var(L)
End If
If Left(C, 1) "&" Then
Label5.Caption = C
Else
Label5.Caption = Var(C)
End If
If Left(R, 1) "&" Then
Label6.Caption = R
Else
Label6.Caption = Var(R)
End If
End Sub
Function Var(str As String) As String
Select Case Mid(str, 2, 1)
Case "T"
Var = Time
Case "D"
Var = Date
Case "A"
Var = ActiveSheet.Name
Case "F"
Var = ActiveWorkbook.Name
End Select
End Function
Die Function Var muß noch auf alle Kürzel erweitert werden.
&L Richtet nachfolgende Zeichen links aus.
&C Zentriert das nachfolgende Zeichen.
&R Richtet nachfolgende Zeichen rechts aus.
&E Schaltet Doppelt Unterstreichen ein oder aus.
&X Schaltet Hochstellen ein oder aus.
&Y Schaltet Tiefstellen ein oder aus.
&B Schaltet Fettdruck ein oder aus.
&I Schaltet Kursivdruck ein oder aus.
&U Schaltet Unterstreichen ein oder aus.
&S Schaltet Durchstreichen ein oder aus.
&D Druckt das aktuelle Datum.
&T Druckt die aktuelle Zeit.
&F Druckt den Namen des Dokuments.
&A Druckt den Namen des Registers ( Tabellenname )
einer Arbeitsmappe.
&P Druckt die Seitenzahl.
&P+Zahl Druckt die Seitenzahl zuzüglich der angegebenen Zahl.
&P-Zahl Druckt die Seitenzahl abzüglich der angegebenen Zahl.
&& Druckt ein einzelnes kaufmännisches Und-Zeichen.
&"Schriftart" Druckt die nachfolgenden Zeichen in der angegebenen
Schriftart. Schriftart muss von Anführungszeichen
eingeschlossen sein.
&nn Druckt die nachfolgenden Zeichen im angegebenen
Schriftgrad. Geben Sie eine zweistellige Zahl an, um den
Schriftgrad anzugeben.
&N Druckt die Gesamtanzahl der Seiten eines Dokumentes.
allerdings können diese auch in Kombination vorkommen, deshalb ist es besser diese ZeileSelect Case Mid(str, 2, 1)
durch diese zu ersetzenSelect Case Replace(str, "&", "")
die verwendeten Kombinationskürzel müssen dann auch in die Funktion reinIf Replace(L,"&", "") = "G" Then
Label1.Picture = LoadPicture(ActiveSheet.PageSetup.LeftHeaderPicture.Filename)
Else
Label1.Picture = LoadPicture("")
End If
Das Bild darf aber kein png sein