Bonjour,
mon morceau de programme copie la feuille active dans un nouveau fichier et le convertit en pdf.
Mais à partir la ligne "ActiveWorkbook.Close " le programme ne semble plus repondre..
Je suis donc à la recherche d'une astuce ou solution.
Merci par avance.
mon morceau de programme copie la feuille active dans un nouveau fichier et le convertit en pdf.
Mais à partir la ligne "ActiveWorkbook.Close " le programme ne semble plus repondre..
Je suis donc à la recherche d'une astuce ou solution.
Merci par avance.
Code:
Sub CopieFeuilleDocumentsPdf()
' déclarations des variables
Dim Std As String ' Liste de nom fichier Document
Dim Crd As String
Dim Soc As String
Dim The As String
Dim Fic As String
Dim Nfd As String
Dim Che As String
Dim pdfjob As PDFCreator.clsPDFCreator
'
Crd = Range("AA5") ' Chemin du repertoire Documents
Soc = Range("O11") ' Nom Sociètè
The = Range("B21") ' Thème
Fic = Range("AA1") ' Fichier logiciel
Che = Range("AA2") ' Chemin logiciel
' Test pour verifier que le chemin existe
If Dir$(Crd) = "" Then
' Chemin du fichier copier
Std = Crd & "\" & Soc & " " & Format(Date, "yyyy_mm_dd") & " " & Format(Time, "hh_mm") & " " & The & ".pdf"
Nfd = Soc & " " & Format(Date, "yyyy_mm_dd") & " " & Format(Time, "hh_mm") & " " & The & ".pdf"
ActiveWorkbook.SaveAs Filename:=Nfd
If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
Set pdfjob = New PDFCreator.clsPDFCreator
With pdfjob
' Demarre Pdf creator
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "PrtPDFCreator"
'Application.Wait (Now + TimeValue("0:00:05"))
Exit Sub
End If
' Parametres Pdf creator
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = Crd 'Chemin du fichier
.cOption("AutosaveFilename") = Nfd 'Nom du fichier
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With
'Imprime le document en PDF
ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
'Attend que le document soit entré dans la file d'impression
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
'Attend que l'impression du document soit terminée
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Set pdfjob = Nothing
MsgBox "la feuille en Pdf à ètè copièe dans " & vbCrLf & " le fichier documents destinataires:" & vbCrLf & Std
ActiveWorkbook.Close ' à partir de cette ligne le programme semble ne plus fonctionner
Else
MsgBox " Le fichier" & Crd & " est introuvable ?" & vbCrLf & " Vérifier le chemin du fichier :" & vbCrLf & "documents du destinataire."
End If
Windows(Che & "\" & Fic).Activate
MsgBox "Selection de la page document "
Sheets("Documents").Select
ActiveWindow.SmallScroll Down:=-35
End Sub