Ciao Amentinho e benvenuto nel Forum
Ho utilizzato una macro di Anthony che funziona molto bene in excel, adattandola a Word,
Ricorda che devi aver installato PdfCreatorHo aggiunto la macro "CercaNome" per trovare la riga interessata e ricavarmi il nome del file
Assemblando il tutto ho ottenuto questa/e macro
- Codice: Seleziona tutto
Public MioNP As String
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub CercaNome()
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Nome:"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdWord, Count:=4, Extend:=wdExtend
MioN = (Replace(Selection, "Nome: ", ""))
MioNP = Left(MioN, Len(MioN) - 1)
'MsgBox MioNP
End Sub
Sub SalvaPdf()
Call macroPrintPDF1(PercF & "\", NFile) '<<< AGGUNTA
End Sub
Private Function macroPrintPDF1(ByVal PercF As String, ByVal NFile As String)
Dim objPDFCreator '<<< Late Bind
CercaNome
StPdf = Shell("RUNDLL32 PRINTUI.DLL,PrintUIEntry /y /n " & """PDFCreator""")
NFile = MioNP & ".pdf"
Perc = "C:\Temp\"
NFileE = NFile
'On Error Resume Next
If Dir(Perc & NFile) = NFile Then Kill (Perc & NFile)
'On Error GoTo 0
If IsProcessRunning("PDFCreator.exe") Then
Shell "taskkill /f /im PDFCreator.exe", vbHide
End If
'Call ProcessRunning
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
Sleep 3000
Set objPDFCreator = CreateObject("PDFCreator.clsPDFCreator")
aaa1 = objPDFCreator.cProgramIsRunning
With objPDFCreator
.cStart "/NoProcessingAtStartup"
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = Perc
.cOption("AutosaveFilename") = NFile
.cOption("AutosaveFormat") = 0
aaa = .cOption("AutosaveFilename")
.cVisible = False
.cClearCache
End With
ActiveDocument.ActiveWindow.PrintOut Range:=wdPrintFromTo, From:="1", To:="1"
'ActiveDocument.PrintOut Copies:=1 ', ActivePrinter:="PDFCreator"
objPDFCreator.cPrinterStop = False
'attesa disponibilita' file finale
Do
DoEvents
Loop Until Dir(Perc & NFile) = NFile
'clear finale oggetto e kill processo
Set objPDFCreator = Nothing
Shell "taskkill /f /im PDFCreator.exe", vbHide
'StDef = Shell("C:\PrintDefault.bat")
Sleep 3000
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
Dovrai avviare la macro "SalvaPdf" il resto viene da se.
ciao