Moderatori: Anthony47, Flash30005
Sub ppp()
Dim AdReader As Object
myFName = "C:\Documents and Settings\USER\My Documents\Documento.pdf"
Set AdReader = CreateObject("AcroPDF.PDF") '.1")
AdReader.LoadFile(myFName)
'myERR = AdReader.printAll
myErr = AdReader.PrintPages(2, 3)
End Sub
Public PercFE, NFileE, STrD, STrDTesta, STrDCoda As String
Sub SalvaPdf()
Call macroPrintPDF1(PercF & "\", NFile)
End Sub
Private Function macroPrintPDF1(ByVal PercF As String, ByVal NFile As String)
Dim objPDFCreator '<<< Late Bind
StPdf = Shell("RUNDLL32 PRINTUI.DLL,PrintUIEntry /y /n " & """PDFCreator""")
For NF = 1 To Worksheets.Count
Nfoglio = Sheets(NF).Name
NFile = Nfoglio & ".pdf"
Perc = ThisWorkbook.Path & "\"
PercF = Perc
PercFE = PercF
NFileE = NFile
'On Error Resume Next
If Dir(PercF & NFile) = NFile Then Kill (PercF & NFile)
'On Error GoTo 0
If IsProcessRunning("PDFCreator.exe") Then
Shell "taskkill /f /im PDFCreator.exe", vbHide
End If
azz = Timer
Do
If Not IsProcessRunning("PDFCreator.exe") Then Exit Do
DoEvents
If Timer > (azz + 30) Or (Timer < azz And Timer > 25) Then
MsgBox ("Non e' stato possibile chiudere PDFCreator; processo abortito")
Exit Function
End If
Loop
Application.Wait (Now + TimeValue("0:00:02"))
Set objPDFCreator = CreateObject("PDFCreator.clsPDFCreator")
aaa1 = objPDFCreator.cProgramIsRunning
With objPDFCreator
.cStart "/NoProcessingAtStartup"
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = PercF
.cOption("AutosaveFilename") = NFile
.cOption("AutosaveFormat") = 0
aaa = .cOption("AutosaveFilename")
.cVisible = False
.cClearCache
End With
ActiveSheet.PrintOut Copies:=1, ActivePrinter:="PDFCreator" 'stampa "Foglio"
objPDFCreator.cPrinterStop = False
Do
DoEvents
Loop Until Dir(PercF & NFile) = NFile
Next NF
Set objPDFCreator = Nothing
Shell "taskkill /f /im PDFCreator.exe", vbHide
'StDef = Shell("C:\PrintDefault.bat")
Application.Wait (Now + TimeValue("0:00:03"))
sFile = ""
For NF = 1 To Worksheets.Count
If NF = 1 Then
sFile = Sheets(NF).Name & ".pdf"
Else
sFile = sFile & " " & Sheets(NF).Name & ".pdf"
End If
Next NF
sOutput = "MergeFile.pdf"
Open Perc & "temp.bat" For Output As #1
Print #1, "cd " & Perc
Print #1, "pdftk " & sFile & " cat output " & sOutput
Close #1
Application.Wait (Now + TimeValue("0:00:05"))
abc = Shell(Perc & "temp.bat")
End Function
Private Function IsProcessRunning(ByVal ProcName As String) As Boolean
Dim objWMIService, objProcess, colProcess
Dim strComputer, strList
'
strComputer = "."
'
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
Set colProcess = objWMIService.ExecQuery _
("Select * from Win32_Process")
For Each objProcess In colProcess
If CBool(InStr(1, objProcess.Name, ProcName, vbTextCompare)) Then
IsProcessRunning = True
Exit Function
End If
Next
End Function
Option Explicit
Private Declare 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
Sub stampa()
On Error Resume Next
Dim X As Long
X = ShellExecute(0, "Print", "C:\file.pdf", "", "", 1)
End Sub
Option Explicit
Private Declare 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
Sub stampa()
Dim X As Long
Dim strPath, strParam As String
On Error Resume Next
strPath = "C:\File.pdf"
strParam = " /A " & Chr(34) & "page=4" & Chr(34) & strPath
X = ShellExecute(0, "Open", "AcroRd32.exe", strParam, "", 1)
End Sub
Public Declare 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
Public Const SW_NORMAL = 1
Public Perc As String
Sub StampaPagPdf()
sFile1 = "NomeFile.pdf" '<<<<< inserire nome corretto file originale
PagS = "1-5" '<<<<< inserire il range delle pagine in questo caso da 1 a 5
sOutput = "FileStampa.pdf" '<<<<<<<<<<< file temporaneo che può essere cancellato dopo il processo di stampa
Perc = ThisWorkbook.Path & "\"
Open Perc & "temp.bat" For Output As #1
Print #1, "cd " & Perc
Print #1, "pdftk A=" & sFile1 & " cat A" & PagS & " output " & sOutput
Close #1
Application.Wait (Now + TimeValue("0:00:05"))
abc = Shell(Perc & "temp.bat")
Application.Wait (Now + TimeValue("0:00:05"))
Call ShellExecute(0, "Print", Perc & sOutput, "", "", 0)
End Sub
panix76 ha scritto:Mi rimane solo da capire come eseguire da macro il file temp.bat
Application.Dialogs(xlDialogPrint).Show
Sub cambia_print()
Dim strDefaultPrinter As String
Dim objPrinter As Object
' get current default printer.
'strDefaultPrinter = Application.Printer.DeviceName
Set objPrinter = CreateObject("WScript.Network")
' switch to printer of your choice:
objPrinter.SetDefaultPrinter ("nome_nuova_stampante_di_default")
' swtich back
'objPrinter.SetDefaultPrinter (strDefaultPrinter)
End Sub
Sub CambiaStampante()
Dim strPrinterOld As String
Set objPrinter = CreateObject("WScript.Network")
strPrinterOld = Application.ActivePrinter
strPrinterOld = Replace(strPrinterOld, " su Ne00:", "")
'cambia la stampante predefinita
objPrinter.SetDefaultPrinter "NuovaStampante"
'...
'...
'...
'alla fine resettare alla stampante predefinita originale
objPrinter.SetDefaultPrinter strPrinterOld
End Sub
strDefaultPrinter = Application.ActivePrinter
pos = InStrRev(strDefaultPrinter, "su")
strDefaultPrinter = Mid(strDefaultPrinter, 1, (pos - 2))
ShellExecute(0, "Print", file_stampare, "", "", 0)
Copie = 5 '<<<<< può essere anche il valore di una cella di excel ;-)
For NC = 1 to Copie
ShellExecute(0, "Print", file_stampare, "", "", 0)
Next NC
Call ShellExecute(0, "Print", file_stampare, "", "", 0)
panix76 ha scritto: L'ho provato funziona, ho solo sostituito al posto di VB.Printer.DeviceName il nome della stampante desiderata.
Torna a Applicazioni Office Windows
Inserire dati filtrati da 2 file ad un terzo file Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 14 |
File batch per copiare file selezionato da menu contestuale Autore: valle1975 |
Forum: Programmazione Risposte: 3 |
Codice VBA per stampare UserForm attiva Autore: Carletto Ribolla |
Forum: Applicazioni Office Windows Risposte: 8 |
Visitano il forum: Nessuno e 14 ospiti