un composant activex ne peut pas créer d'objet vba

brizard

XLDnaute Nouveau
Bonsoir, suite à la mise à jour de PdfCreator ma macro excel 7 vba plante et m'indique ce message.
"un composant activex ne peut pas créer d'objet vba"

Cela plante à la ligne "Set JobPDF = CreateObject("PDFCreator.clsPDFCreator")"
Ci dessous la macro.
Merci de m'aider
Cordialement

Sub Imprim_PdfCreator()
'Dim objMessage As CDO.Message
Dim JobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String



'Vérifi la présence du dossier de sauvegarde, et le cré si il n'existe pas.
'Chemin = "C:\Documents and Settings\COMPTOIRE ST\Mes documents\FEUILLES DE CAISSES\CAISSE " & AnneeEnCours & "\" & MoisEnCoursEnLettre
'Set Fso = CreateObject("Scripting.FileSystemObject")
'Reponse = Fso.folderExists(Chemin)
'If Reponse = False Then MkDir "C:\Documents and Settings\COMPTOIRE ST\Mes documents\FEUILLES DE CAISSES\CAISSE " & AnneeEnCours: MkDir "C:\Documents and Settings\COMPTOIRE ST\Mes documents\FEUILLES DE CAISSES\CAISSE " & AnneeEnCours & "\" & MoisEnCoursEnLettre


sNomPDF = "ST PATRICK " & AnneeEnCours & " " & DateDeTravail & ".pdf"
'sCheminPDF = "C:\Documents and Settings\ST\Mes documents\FEUILLES DE CAISSES\CAISSE & AnneeEnCours\MoisEnCours"
'sCheminPDF = "C:\Documents and Settings\COMPTOIRE ST\Mes documents\FEUILLES DE CAISSES\CAISSE " & AnneeEnCours & "\" & MoisEnCoursEnLettre
sCheminPDF = "C:\ST PATRICK\FEUILLES DE CAISSES\CAISSE " & AnneeEnCours & "\" & MoisEnCoursEnLettre
If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub

Set JobPDF = CreateObject("PDFCreator.clsPDFCreator")

With JobPDF
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Initialisation de PDFCreator impossible", vbCritical + vbOKOnly, "PDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sCheminPDF
.cOption("AutosaveFilename") = sNomPDF

' 0=PDF, 1=Png, 2=jpg, 3=bmp, 4=pcx, 5=tif, 6=ps, 7=eps, 8=txt
.cOption("AutosaveFormat") = 0

.cClearCache
End With

With ActiveSheet.PageSetup
'.PrintQuality = 300
.Orientation = xlLandscape
'.PaperSize = xlPaperA4
.Zoom = 100

End With




Selection.PrintOut Copies:=1, Collate:=True, ActivePrinter:="PDFCreator"
'ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"

'Fichier dans la file d'attente
Do Until JobPDF.cCountOfPrintjobs = 1
DoEvents
Loop
JobPDF.cPrinterStop = False

'Attendre que la file d'attente soit vide
Do Until JobPDF.cCountOfPrintjobs = 0
DoEvents
Loop
JobPDF.cClose
Set JobPDF = Nothing

'Set objMessage = CreateObject("CDO.Message")
'With objMessage
'.Subject = "Example"
'.From = "xxxxx@wanadoo.fr"
'.To = "yyyyy@orange.fr"
'.TextBody = "Texte dans le corps de message"
'.AddAttachment sCheminPDF & sNomPDF
' .Send
'End With

'Set objMessage = Nothing

End Sub
 

Roland_M

XLDnaute Barbatruc
Re : un composant activex ne peut pas créer d'objet vba

bonjour,

j'ai trouvé ce code si ça peut aider !?
il faut peut être revoir le chemin !?
faire essai sur la macro TestRefPDF

Code:
'Appel recherche et active si non
Sub TestRefPDF()
    If Not ReferenceActive("PDFCreator") Then ActiverReference "C:\Program Files\PDFCreator\PDFCreator.exe"
End Sub

'Fonction Reference Active
Function ReferenceActive(Nom As String) As Boolean
    Dim i As Integer
    Dim NbreRef As Integer
 
    NbreRef = ThisWorkbook.VBProject.References.Count
 
    For i = 1 To NbreRef
        If ThisWorkbook.VBProject.References(i).Name = Nom Then
            ReferenceActive = True
            Exit Function
        End If
    Next i
End Function

'Fonction active reference
Sub ActiverReference(NomComplet As String)
    ThisWorkbook.VBProject.References.AddFromFile NomComplet
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 206
Messages
2 086 202
Membres
103 157
dernier inscrit
youma