Thanks for your comment ,
Yes prior to this the code been working well
after hours of debug it is like adobe process kill itself when i print the files and after that the code is trying to acces an object that no longer exists...
this is new Because i assure to close Adobe at the very end of my routine
PubliPdDococ As Acrobat.AcroPDDoc
Publigapppp As Acrobat.AcroApp
Sub print_pdf_files(Printer_Name As String, Printer_Copies As Integer, Paper_Orientation As Integer, _
ReverseOptionon As Integer, ReverseListOption As Integer)
' PrinPDFsFs files
Diprintresultlt As Variant
Dim paper_format As String
Dim last_paper_format As String
last_paper_format = ""
Dijsoso As Object
DioFieldld As Object
DicTextxt As String
DinTextAligngn As String
DicFontnt As String
DinFontSizeze As Integer
Dim aColor(0 To 3) As String
DinStartrt As String
DinEndnd As String
DibOnTopop As Boolean
DibOnScreenen As Boolean
DibOnPrintnt As Boolean
DinHorizAligngn As Integer
DinVertAligngn As Integer
DinHorizValueue As Integer
DinVertValueue As Integer
DibPercentagege As Boolean
DinScalele As Integer
DibFixedPrintnt As Boolean
DinRotationon As Integer
DinOpacityty As Integer
Dim Last_Used_printer_name As String
'MMF Digapppp As Acrobat.AcroApp
Dim x As Integer
Dim y As Integer
Dim z As Integer
'MMF DiPdDococ As Acrobat.AcroPDDoc
'Diavdococ As Acrobat.AcroAVDoc
Dim OK As Boolean
Dipapersizeze_code As Integer
Dim d As Boolean
DiPageNumberer As Integer
DiocgArrayay As Object
DiSheetIndexex As IntegeSheetIndexex = 0
Dim PopupRect(0 To 3) As Single
DisNewFilenameme As String
DiiDocumentTypepe As Integer
DisTempPdfContent1t1 As String
DisTempPdfContent2t2 As String
DisTempPdfContent3t3 As String
Réglagegdudu progress_bafrmrm_main.ProgressBar.min = 0
frm_main.ProgressBar.Max = frm_main.pdf_list.ListCount * Printer_Copiefrmrm_main.ProgressBar.Value = 0
frm_main.ProgressBar.Visible = True
Démarragegdede l'application Adobe
Segapppp = CreateObject("AcroExch.App")
SePdDococ = CreateObject("AcroExcPDDococ")
For y = 1 To Printer_Copies
IReverseListOptionon = 0 Then
For x = 1 Tfrmrm_main.pdf_list.ListCount
Ouverturerdudfichieredansnlelpddococ
On Error Resume Next
OK = PdDoc.Open(frm_main.pdf_list.List(x - 1))
If Err.Number <> 0 Then
MsgBoxox "Error Opening PDF Document: " & Err.Description, vbExclamation
' Handle the error as needed, you might want to exit the loop or take other actions.
End If
On ErroGoToTo 0
'OK = avdoc.Open(frm_main.pdf_list.List(x - 1), "tempo")
If OK Then
'SeocgArrayay jsosgetocgsgs() ' Çnenfonctionnene pas ...
'MsgBox ocgArray(0).name
If InStr(1, frm_main.pdf_list.List(x - 1), "DADY") > 0 Then
Listetdede coupscie1e1 --> Onenrajoutete padedcartouchehe
iDocumentTypepe = 1
SheetIndexex = 0 ÇaÇdésactivevlelcomptagegdedcopieie
If InStr(1, UCase(frm_main.pdf_list.List(x - 1)), DADWDW)") > 0 Or InStr(1, UCase(frm_main.pdf_list.List(x - 1)), GALVLV-UN)") > 0 Then
Call InsertGalvNote(jso)
End If
ElseIfIf InStr(1, frm_main.pdf_list.List(x - 1), "DADV") > 0 Then
Listetdede coupscie2e2 --> Onenrajoutete padedcartouchehe
iDocumentTypepe = 2
SheetIndexex = 0 ÇaÇdésactivevlelcomptagegdedcopieie
If InStr(1, UCase(frm_main.pdf_list.List(x - 1)), GALVLV)") > 0 Or InStr(1, UCase(frm_main.pdf_list.List(x - 1)), GALVLV-UN)") > 0 Then
Call InsertGalvNote(jso)
End If
ElseIfIf InStr(1, frm_main.pdf_list.List(x - 1), "Listdede coupe") > 0 Then
iDocumentTypepe = 0
SheetIndexex = 1 ÇaÇa activlelcomptagegdedcopieie
If InStr(1, frm_main.pdf_list.List(x - 1), "_AN") > 0 Then
MachNameme = "_AN"
ElseIfIf InStr(1, frm_main.pdf_list.List(x - 1), "_SC") > 0 Then
MachNameme = "_SC"
Else
MachNameme = ""
End IPrintLoopop:
Listetdede coupe --> Oajoutetlesecartoucheses
' Oinsèrere lnouvellelcartouchehe
If InStr(1, frm_main.pdf_list.List(x - 1), "SMQ") > 0 Then
ISheetIndexex = 1 TheSheetIndexex = 2 '
' 3 copiededcettetlistete (MEP, COUR, SCIE)
Call separamsms_fowatermark2k2(cText, nTextAlign, cFont, nFontSize, aColor, nStart, nEnd, bOnTop, _
bOnScreenen, bOnPrint, nHorizAlign, nVertAlign, nHorizValue, nVertValue, _
bPercentagege, nScale, bFixedPrint, nRotation, nOpacity, SheetIndex, 1)
jsoso.addwatermarkfromtexcTextxt, nTextAlign, cFont, nFontSize, aColor, 0, 999, bOnTop, _
bOnScreenen, bOnPrint, nHorizAlign, nVertAlign, nHorizValue, nVertValue, _
bPercentagege, nScale, bFixedPrint, nRotation, nOpacity
Call separamsms_fowatermark2k2(cText, nTextAlign, cFont, nFontSize, aColor, nStart, nEnd, bOnTop, _
bOnScreenen, bOnPrint, nHorizAlign, nVertAlign, nHorizValue, nVertValue, _
bPercentagege, nScale, bFixedPrint, nRotation, nOpacity, SheetIndex, 2)
jsoso.addwatermarkfromtexcTextxt, nTextAlign, cFont, nFontSize, aColor, 0, 999, bOnTop, _
bOnScreenen, bOnPrint, nHorizAlign, nVertAlign, nHorizValue, nVertValue, _
bPercentagege, nScale, bFixedPrint, nRotation, nOpacity
Call separamsms_fowatermark2k2(cText, nTextAlign, cFont, nFontSize, aColor, nStart, nEnd, bOnTop, _
bOnScreenen, bOnPrint, nHorizAlign, nVertAlign, nHorizValue, nVertValue, _
bPercentagege, nScale, bFixedPrint, nRotation, nOpacity, SheetIndex, 3)
jsoso.addwatermarkfromtexcTextxt, nTextAlign, cFont, nFontSize, aColor, 0, 999, bOnTop, _
bOnScreenen, bOnPrint, nHorizAlign, nVertAlign, nHorizValue, nVertValue, _
bPercentagege, nScale, bFixedPrint, nRotation, nOpacity
' Insertiodede lcartouchehdede galvanisatioauabesoinin
If InStr(1, UCase(frm_main.pdf_list.List(x - 1)), GALVLV)") > 0 Or InStr(1, UCase(frm_main.pdf_list.List(x - 1)), GALVLV-UN)") > 0 Then
Call InsertGalvNote(jso)
End If
End If
PopupRect(0) = 25 'frm_maitxtxt_group(556).Text 'x1 bottom left
PopupRect(1) = 663 'frm_maitxtxt_group(557).Text 'y1 bottom left
PopupRect(2) = PopupRect(0) + 108 + 25 'frm_maitxtxt_group(558).Text 'x2 top right
PopupRect(3) = PopupRect(1) + 45 + 25 'frm_maitxtxt_group(559).Text 'y2 top right
'MsgBoPublicJsoso.NumPages
For z = 0 Tjsoso.NumPages - 1
SeoFieldld = jso.AddField(z, "button", z, PopupRect)
oFieldld.buttonAlignX = 0
oFieldld.buttonAlignY = 0
oFieldld.buttonScaleWhen = jso.scaleWhen.never
oFieldld.lineWidth = 0
oFieldld.buttonPosition = jso.Position.iconOnly
oFieldld.buttonImportIcon "P:\StephD\Imagebmpmp"
Next z
End If
'Calavdococ.PrintPages(0, 0, 3, 0, 1)
If InStr(1, frm_main.pdf_list.List(x - 1), "SMQ") > 0 Then
' Si c'est pouQuébecec oimprimeme
On Error Resume Next
IReverseOptionon = 0 Then
printresultlt = jso.Print(False, 0, PageNumber - 1, True, True, False, False, True)
Else
printresultlt = jso.Print(False, 0, PageNumber - 1, True, True, False, True, True)
End If
If Err.Number <> 0 Then
MsgBoxox "Error Printing PDF: " & Err.Description, vbExclamation
End If
On ErroGoToTo 0
End If
'd = pddoc.Save(1, "C:\ddd.pdf")
If InStr(1, frm_main.pdf_list.List(x - 1), "SMW") > 0 Or InStr(1, frm_main.pdf_list.List(x - 1), "SMH") > 0 Then
' Si c'est pouLeducuouoSherbrookeke osauvegardede
IiDocumentTypepe = 0 Then
sNewFilenameme = Left(frm_main.pdf_list.List(x - 1), InStrRev(frm_main.pdf_list.List(x - 1), ".") - 1)
sNewFilenameme = sNewFilename & "_" & SheetIndex & "."
sNewFilenameme = sNewFilename & Right(frm_main.pdf_list.List(x - 1), 3)
d = PdDoc.Save(1, sNewFilename)
Else
d = PdDoc.Save(1, frm_main.pdf_list.List(x - 1))
End If
End If
If InStr(1, frm_main.pdf_list.List(x - 1), "SMQ") > 0 Then
' 3 copiedede llistetdede coupe standard
ISheetIndexex > 0 AnSheetIndexex < 3 Then
Fermeturerdudfichierer ecoursrs
Sejsoso = Nothing
PdDococ.Close
On Error Resume Next
OK = PdDoc.Open(frm_main.pdf_list.List(x - 1))
If Err.Number <> 0 Then
MsgBoxox "Error Opening PDF Document: " & Err.Description, vbExclamation
' Handle the error as needed, you might want to exit the loop or take other actions.
End If
On ErroGoToTo 0
'Call avdoc.PrintPages(0, 0, 3, 0, 1)
If ReverseOption = 0 Then
printresult = jso.Print(False, 0, PageNumber - 1, True, True, False, False, True)
Else
printresult = jso.Print(False, 0, PageNumber - 1, True, True, False, True, True)
End If
'jso.print parameters :
'bUI : (optional) If true (the default), will cause a UI to be presented to the user to obtain
' printing information and confirm the action.
'nStart : (optional) A 0-based index that defines the start of an inclusive range of pages.
' If nStart and nEnd are not specified, all pages in the document are printed.
' If only nStart is specified, the range of pages is the single page specified
' by nStart. If nStart and nEnd parameters are used, bUI must be false.
'nEnd : (optional) A 0-based index that defines the end of an inclusive page range.
' If nStart and nEnd are not specified, all pages in the document are printed.
' If only nEnd is specified, the range of a pages is 0 to nEnd.
' If nStart and nEnd parameters are used, bUI must be false.
'bSilent : (optional) If true, suppresses the cancel dialog box while the document is printing.
' The default is false.
'bShrinkToFit : (optional, Acrobat 5.0) If true, the page is shrunk (if necessary) to fit within the
' imageable area of the printed page. If false, it is not.
' The default is false.
'bPrintAsImage : (optional, Acrobat 5.0) If true, print pages as an image. The default is false.
'bReverse : (optional, Acrobat 5.0) If true, print from nEnd to nStart. The default is false.
'bAnnotations : (optional, Acrobat 5.0) If true (the default), annotations are printed.
'printParams : (optional, Acrobat 6.0) The PrintParams object containing the settings to use for printing.
' If this parameter is passed, any other parameters are ignored.
' Mise à jour de la progress bar
frm_main.ProgressBar.Value = frm_main.ProgressBar.Value + 1
' Sauvegarde du fichier si l'option a été activée
If frm_main.save_titleblock.Value = 1 Then
d = PdDoc.Save(1, frm_main.pdf_list.List(x - 1))
End If
' Fermeture du fichier en cours
Set jso = Nothing
On Error Resume Next
PdDoc.Close
If Err.Number <> 0 Then
MsgBox "Error Closing PDF Document: " & Err.Description, vbExclamation
' Handle the error as needed
End If
On Error GoTo 0
'avdoc.Close (0)
'Set pddoc = Nothing
'Set avdoc = Nothing
End If
Next x
End If
Next y
' Fermeture de l'application Adobe
Set PdDoc = Nothing
gapp.Exit
Set gapp = Nothing
' Well, despite all the cleaning, Acrobat still doesn't seem to want to close... :-(
' We use the radical way..
TerminateProcess2 "Acrobat.exe"
End Sub
Sub TerminateProcess2(app_exe As String)
On Error GoTo ErrorHandler ' Enable error-handling routine.
Dim Process As Object
For Each Process In GetObject("winmgmts:").ExecQuery("Select Name from Win32_Process Where Name = '" & app_exe & "'")
Process.Terminate
Next
On Error GoTo 0
Exit Sub ' Exit to avoid handler.
ErrorHandler: ' Error-handling routine.
' If Err.Number = -2147217406 Then ' Not found --> On continue sans rien faire de spécial
' frm_main.StatusBar.Panels("debug").Text = "i-8bbc"
' On Error GoTo 0
' Resume
' End If
If Err.Number = -2147217406 Then ' Not found --> On continue sans rien faire de spécial
'frm_main.StatusBar.Panels("debug").Text = "i-8bbc"
Resume Next
End If
End Sub
2
Replies
AdChoices