AW: Excel friert ein, wenn pdf geöffnet werden soll
28.03.2019 17:00:19
wired
Sorry ...
Hier jetzt hoffentlich vollständig:
Public Function PrintThisDoc(formname As Long, FileName As String)
On Error Resume Next
Dim X As Long
X = ShellExecute(formname, "Print", FileName, 0&, 0&, 3)
End Function
Public Function Standarddruckername() As String
Dim strTemp As String
Dim lngGerät As Long
strTemp = String(1024, 0)
lngGerät = GetProfileString("windows", "device", 0&, strTemp, 1024)
Standarddruckername = Left(strTemp, InStr(strTemp, ",") - 1)
End Function
Public Function StandarddruckerÄndern(ByVal Druckername As String) As Boolean
StandarddruckerÄndern = CBool(SetDefaultPrinter(Druckername & vbNullChar))
End Function
Sub PrintUnterlagen()
Dim strName As String
Dim lngZeichen As Long
Dim lngret As Long
'Momentanen Standardrucker auslesen
ThisWorkbook.Sheets("Daten").Range("B46").Value = Standarddruckername
'Print2Image als vorübergehenden Standarddrucker wählen
Call StandarddruckerÄndern("Print-2-Image")
If Worksheets("Antrag_Bearbeitung").Range("A2") = "A" Or Worksheets("Antrag_Bearbeitung").Range("A2") = "B" Then
Dim printThis
Dim strDir As String
Dim strFile As String
ThisWorkbook.Sheets("Daten").Range("B20").Value = Standarddruckername
Call StandarddruckerÄndern("Print-2-Image")
strDir = ThisWorkbook.Sheets("Daten").Range("B7")
strFile = ThisWorkbook.Sheets("Antrag_Bearbeitung").Cells(5, 4)
printThis = PrintThisDoc(0, strDir & "\" & strFile)
SendKeys ThisWorkbook.Sheets("Daten").Cells(3, 5)
Call SendKeys("{tab}", True)
AppActivate ("Dokumentbeschlagwortung")
Call SendKeys("{enter}", True)
Dim printThis1
Dim strDir1 As String
Dim strFile1 As String
ThisWorkbook.Sheets("Daten").Range("B20").Value = Standarddruckername
Call StandarddruckerÄndern("Print-2-Image")
strDir1 = ThisWorkbook.Sheets("Daten").Range("B7")
strFile1 = ThisWorkbook.Sheets("Antrag_Bearbeitung").Cells(7, 4)
printThis1 = PrintThisDoc(0, strDir1 & "\" & strFile1)
[
]