Userform Fenster drucken

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Manuel,
teste mal:

Option Explicit

Public Sub PrintUserForm()
    Dim objWMI As Object, objItem As Object
    Dim strDefaultPrinter As String
    Dim strOldPrinter As String, strNewPrinter As String
    Dim ialngIndex As Long
    Dim avntTemp As Variant
    strOldPrinter = Application.ActivePrinter
    If Application.Dialogs(xlDialogPrinterSetup).Show Then
        Set objWMI = GetObject("winmgmts:\\.\root\cimv2"). _
            ExecQuery("SELECT * FROM Win32_Printer WHERE DEFAULT = 'True'")
        For Each objItem In objWMI
            strDefaultPrinter = objItem.Name
        Next
        avntTemp = Split(Application.ActivePrinter)
        For ialngIndex = LBound(avntTemp) To UBound(avntTemp) - 2
            strNewPrinter = strNewPrinter & avntTemp(ialngIndex) & " "
        Next
        strNewPrinter = Trim$(strNewPrinter)
        Set objWMI = GetObject("winmgmts:\\.\root\cimv2"). _
            ExecQuery("SELECT * FROM Win32_Printer WHERE Name = '" & strNewPrinter & "'")
        For Each objItem In objWMI
            Call objItem.SetDefaultPrinter
        Next
        Call Load(Object:=UserForm1)
        Call UserForm1.PrintForm
        Call Unload(Object:=UserForm1)
        Set objWMI = GetObject("winmgmts:\\.\root\cimv2"). _
            ExecQuery("SELECT * FROM Win32_Printer WHERE Name ='" & strDefaultPrinter & "'")
        For Each objItem In objWMI
            Call objItem.SetDefaultPrinter
        Next
        Set objWMI = Nothing
        Application.ActivePrinter = strOldPrinter
    End If
End Sub

Gruß
Nepumuk

Option Explicit Private Declare Function MapVirtualKeyA Lib "user32.dll" ( _ ByVal wCode As Long, _ ByVal wMapType As Long) As Long Private Declare Sub keybd_event Lib "user32.dll" ( _ ByVal bVk As Byte, _ ByVal bScan As Byte, _ ByVal dwFlags As Long, _ ByVal dwExtraInfo As Long) Private Const KEYEVENTF_KEYUP As Long = &H2 Public Sub PrintMe() Dim lngAltScan As Long Dim objWorksheet As Worksheet Dim strOldPrinter As String strOldPrinter = Application.ActivePrinter If Application.Dialogs(xlDialogPrinterSetup).Show Then lngAltScan = MapVirtualKeyA(vbKeyMenu, 0&) Call keybd_event(vbKeyMenu, lngAltScan, 0&, 0&) Call keybd_event(vbKeySnapshot, 0&, 0&, 0&) DoEvents Call keybd_event(vbKeyMenu, lngAltScan, KEYEVENTF_KEYUP, 0&) Set objWorksheet = ThisWorkbook.Worksheets.Add With objWorksheet Call .Paste .PageSetup.Orientation = xlLandscape Call .PrintOut Application.DisplayAlerts = False Call .Delete Application.DisplayAlerts = True End With Set objWorksheet = Nothing Application.ActivePrinter = strOldPrinter End If End Sub

Option Explicit Private Declare Function MapVirtualKeyA Lib "user32.dll" ( _ ByVal wCode As Long, _ ByVal wMapType As Long) As Long Private Declare Sub keybd_event Lib "user32.dll" ( _ ByVal bVk As Byte, _ ByVal bScan As Byte, _ ByVal dwFlags As Long, _ ByVal dwExtraInfo As Long) Private Const KEYEVENTF_KEYUP As Long = &H2 Public Sub PrintMe() Dim lngAltScan As Long Dim objWorksheet As Worksheet lngAltScan = MapVirtualKeyA(vbKeyMenu, 0&) Call keybd_event(vbKeyMenu, lngAltScan, 0&, 0&) Call keybd_event(vbKeySnapshot, 0&, 0&, 0&) DoEvents Call keybd_event(vbKeyMenu, lngAltScan, KEYEVENTF_KEYUP, 0&) Set objWorksheet = ThisWorkbook.Worksheets.Add With objWorksheet Call .Paste .PageSetup.Orientation = xlLandscape Call .ExportAsFixedFormat(Type:=xlTypePDF, _ Filename:=ThisWorkbook.Path & "\Userform.pdf", _ Quality:=xlQualityStandard, IgnorePrintAreas:=False, _ OpenAfterPublish:=True) Application.DisplayAlerts = False Call .Delete Application.DisplayAlerts = True End With Set objWorksheet = Nothing End Sub

hallo nepumuk,
danke erstmals,
leider bin ich mit dieser Lösung nicht ganz glücklich da selten aber doch Fehler auftreten.
ich habe mir jetzt selbst eine Lösung gebastelt, jedoch benötige ich noch den Aufruf von Druckereinstellung des ausgewählten Druckers (von Userform Liste). Hier soll das Format, Quer bzw. Hochformat eingestellt werden.
Anbei noch mein Makro
Private Declare PtrSafe Sub Sleep Lib "kernel32.dll" ( _
ByVal dwMilliseconds As Long)

Private Sub Bestätigen_Click()
Dim strPrinter As String
Dim objWMI As Object, objItem As Object
Call Repaint
strPrinter = Application.ActivePrinter
Set objWMI = GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * from Win32_Printer")
For Each objItem In objWMI
If objItem.Name = Druckerauswahl.Liste Then
objItem.SetDefaultPrinter
Exit For
End If
Next
Call Sleep(1000)
Call Messwerte_CableCoil.PrintForm
Set objWMI = GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * from Win32_Printer")
For Each objItem In objWMI
If InStr(1, strPrinter, objItem.Name) > 0 Then
objItem.SetDefaultPrinter
Exit For
End If
Next
Set objWMI = Nothing
Set objItem = Nothing
End Sub

Private Sub Schließen_Click()
Unload Druckerauswahl
End Sub

Private Sub UserForm_Initialize()
Label1.Caption = "Drucken von:"
Label2.Caption = Worksheets("Prüfprotokoll").Range("B3") & "-" & Worksheets("Prüfprotokoll"). _
Range("B14") & "_" & Messwerte_CableCoil.Messung
Dim Printer As Object
Dim Bereich_Printer As Range
Dim Zelle_Printer As Range
Set Printer = CreateObject("Scripting.Dictionary")
With Worksheets("Eingaben")
Set Bereich_Printer = .Range(.Range("AV4"), .Range("AV11").End(xlDown))
End With
For Each Zelle_Printer In Bereich_Printer
Printer(Zelle_Printer.Value) = 0
Next
Druckerauswahl.Liste.List = Printer.keys
End Sub

Drucker werden abgerufen und in die Zellen AV4:AV11 gelistet.
Hast du hier eine Idee ?

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Userform Fenster drucken

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread