Selecionar Configuração da impressora
Enviado: 01 Set 2021 às 11:10
Ola, Estou precisando de ajuda para ajustar a impressora que vai usar para imprimir o arquivo sem caixa de dialogo.
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#Else
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If
Private 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
Private Sub ClosePDF()
Dim strTerminateThis As String
Dim objWMIcimv2 As Object
Dim objProcess As Object
Dim objList As Object
Dim intError As Integer
strTerminateThis = "AcroRd32.exe"
Set objWMIcimv2 = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set objList = objWMIcimv2.ExecQuery("select * from win32_process where name='" & strTerminateThis & "'")
On Error Resume Next
For Each objProcess In objList
intError = objProcess.Terminate
Next
On Error GoTo 0
Set objWMIcimv2 = Nothing
Set objList = Nothing
Set objProcess = Nothing
End Sub
Sub Imprime_PDF_Arq()
Dim printP As String
Dim strDir As String
Dim strDirFile As String
Dim strCop As Single
Dim i As Long
Dim j As Long
Dim Impressora As String
Dim originalPrinter As Single
strDir = "\\BRCJMWS3084971\DEPTOS$\SOP\6. PDF Produto Acabado\Ficha de Emergência\"
With ActiveSheet
For i = 3 To .Cells(Rows.Count, 2).End(xlUp).Row
strDirFile = .Cells(i, 2).Value & ".pdf"
strCop = .Cells(i, 3).Value
If Cells(i, 1) = 8 Then
Impressora = "CJMCER-BRCJMNP04 (HP LaserJet MFP M527) on IP_7.9.170.36:"
Else
Impressora = "BRCJMNP07 on BRCJMNP07:"
End If
Application.ActivePrinter = Impressora
For j = 1 To strCop
printP = PrintThisDoc(0, strDir & "" & strDirFile)
Application.Wait (VBA.Now + VBA.TimeSerial(0, 0, 10))
Call ClosePDF
Next j
Next i
End With
End Sub
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#Else
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If
Private 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
Private Sub ClosePDF()
Dim strTerminateThis As String
Dim objWMIcimv2 As Object
Dim objProcess As Object
Dim objList As Object
Dim intError As Integer
strTerminateThis = "AcroRd32.exe"
Set objWMIcimv2 = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set objList = objWMIcimv2.ExecQuery("select * from win32_process where name='" & strTerminateThis & "'")
On Error Resume Next
For Each objProcess In objList
intError = objProcess.Terminate
Next
On Error GoTo 0
Set objWMIcimv2 = Nothing
Set objList = Nothing
Set objProcess = Nothing
End Sub
Sub Imprime_PDF_Arq()
Dim printP As String
Dim strDir As String
Dim strDirFile As String
Dim strCop As Single
Dim i As Long
Dim j As Long
Dim Impressora As String
Dim originalPrinter As Single
strDir = "\\BRCJMWS3084971\DEPTOS$\SOP\6. PDF Produto Acabado\Ficha de Emergência\"
With ActiveSheet
For i = 3 To .Cells(Rows.Count, 2).End(xlUp).Row
strDirFile = .Cells(i, 2).Value & ".pdf"
strCop = .Cells(i, 3).Value
If Cells(i, 1) = 8 Then
Impressora = "CJMCER-BRCJMNP04 (HP LaserJet MFP M527) on IP_7.9.170.36:"
Else
Impressora = "BRCJMNP07 on BRCJMNP07:"
End If
Application.ActivePrinter = Impressora
For j = 1 To strCop
printP = PrintThisDoc(0, strDir & "" & strDirFile)
Application.Wait (VBA.Now + VBA.TimeSerial(0, 0, 10))
Call ClosePDF
Next j
Next i
End With
End Sub