Private Sub Aperçu_Click()
Dim Rep As Integer
Dim a As String
Dim b As String
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim i As Byte
Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String
Dim oldprint As String
Dim Nomfichier
oldprint = Application.ActivePrinter
Application.ActivePrinter = "PDFCreator sur Ne00:"
If Auteur.Text <> "" Then
Feuil2.Select
Range("A2:F9").ClearContents
Dim k As Integer, j As Integer
'Boucle sur toutes les lignes
a = Initiale.Caption
b = Numdevis.Caption
Feuil2.Select
For k = 1 To Recap.ListItems.Count
Cells(k + 1, 1) = Recap.ListItems(k).Text
'Boucle sur les colonnes
For j = 1 To Recap.ColumnHeaders.Count - 1
Cells(k + 1, j + 1) = Recap.ListItems(k).ListSubItems(j).Text
Next j
Next k
Set WordApp = CreateObject("word.application") 'ouvre une session Word
Set WordDoc = WordApp.Documents.Open("C:\Users\****\Desktop\DAI.doc") 'ouvre le document Word
WordDoc.Bookmarks("Société").Range.Text = Client.Text
WordDoc.Bookmarks("Contact").Range.Text = Contact.Text
WordDoc.Bookmarks("Email").Range.Text = Email.Text
WordDoc.Bookmarks("Fax").Range.Text = Fax.Text
WordDoc.Bookmarks("Numdevis").Range.Text = a & b
WordDoc.Bookmarks("Modele").Range.Text = Machine.Text
WordDoc.Bookmarks("Serial").Range.Text = Série.Text
WordDoc.Bookmarks("Recap").Select
WordApp.Visible = False 'Word est masqué pendant l'opération
Range("A1:F10").Copy
WordApp.Selection.Paste
WordDoc.Tables(1).AutoFitBehavior wdAutoFitWindow
Application.CutCopyMode = False
WordDoc.SaveAs ("C:\Users\****\Desktop\" & b & ".doc")
'Application.ActivePrinter = "PDFCreator sur Ne00:"
sPDFName = b & ".pdf"
sPDFPath = ("C:\Users\****\Desktop")
Set pdfjob = New PDFCreator.clsPDFCreator
With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With
'Print the document to PDF
WordDoc.PrintOut Copies:=1 ' ActivePrinter:="PDFCreator"
'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Set pdfjob = Nothing
WordDoc.Close True 'ferme le document word en sauvegardant les données
WordApp.Quit 'ferme la session Word
Kill ("C:\Users\****\Desktop\" & b & ".doc")
Range("A2:F9").ClearContents
Feuil1.Select
Application.ActivePrinter = oldprint
Nomfichier = "C:\Users\****\Desktop\" & b & ".pdf"
If Dir(Nomfichier) <> "" Then
ShellExecute 0, "open", Nomfichier, "", "", 0
' Application.PrintOut Background:=True, Copies:=1, Pages:="1"
' Application.Wait Now + TimeValue("00:00:15")
'Application.Quit
Else
MsgBox "Chemin ou fichier introuvable."
End If
Valider.Enabled = True
Modifier.Enabled = True
Else
MsgBox "Qui est l'auteur du devis?", vbOKOnly + vbInformation, "Attention"
End If
End Sub
