Modifier à nouveau un code de convertion en PDF...Résolu

Question

Bonjour le forum....

Donc voilà, j'ai, une macro que j'aimerais modifier... mais je ne sais pas où... je vous explique...


Quand je créé des rapports, j'ai une macro qui me permet de convertir les feuilles sélectionnées... elle fonctionne à merveille... seulement quand j'ai 3 ou 4 rapports à modifier...ça va on valide la conversion 3 ou 4 fois (sur le message "le pointage xxx se trouve a cet emplacement xxx") mais quand il y en a 20 ça commence à être pennible... Hors, ce que je voudrais, c'est que quand je lance la convertion, il m'annonce la fin quand il à tout convertit, du genre "Les rapports de : (affiche le nom des personnes) se trouve a cet emplacemement : xxxxxx .

Voici le code en question :


Sub ToPdf()Dim pdfjob As ObjectDim DefaultPrinterchemsave = ThisWorkbook.Sheets("MATRICE").Range("A111").Value 'tu peux changer la feuille et la cellule'If chemsave = "" Then Exit SubSet pdfjob = CreateObject("PDFCreator.clsPDFCreator")'NomExcel = ThisWorkbook.Name'NomPdf = Left(NomExcel, Len(NomExcel) - 4) & ".pdf"With pdfjobIf .cstart("/NoProcessingAtStartup") = False ThenMsgBox "Can't initialize PDFCreator.", vbCritical + vbOKOnly, "PrtPDFCreator"Exit SubEnd If.cOption("UseAutosave") = 1.cOption("UseAutosaveDirectory") = 1.cOption("AutosaveDirectory") = chemsave 'chemin destination.cOption("AutosaveFilename") = feuil & ".pdf" 'nom de la feuille.cOption("AutosaveFormat") = 0.cClearCacheEnd WithActiveWindow.SelectedSheets.PrintOut From:=1, To:=32766, Copies:=1, ActivePrinter:="PDFCreator" 'on imprime la feuille active'ThisWorkbook.PrintOut Copies:=1, ActivePrinter:="PDFCreator"Do Until pdfjob.cCountOfPrintjobs = 1DoEventsLooppdfjob.cPrinterStop = FalseDo Until pdfjob.cCountOfPrintjobs = 0DoEventsLoopWith pdfjob.cDefaultprinter = DefaultPrinter.cClearCache.cCloseEnd WithSet pdfjob = Nothing'Dim Ret As Variant'Ret = ShellExecute(hwnd, "open", chemsave & To_PDF.ComboBox1.Value & ".pdf", "", vbNullString, 1) 'ouverture du pdfMsgBox "Votre PDF se trouve à cet emplacement: " & chemsave, vbInformation, "Convertir en PDF"End Sub



Je vous remercie à tous pour votre aide... passez une bonne journée...

Christian
 

--

jordane45 · Answer

Bonjour,

macro que j'aimerais modifier... mais je ne sais pas où.

...
 le message "le pointage xxx se trouve a cet emplacement xxx"

Il est facile de voir où se trouve ce message... non ??

MsgBox "Votre PDF se trouve à cet emplacement: " & chemsave, vbInformation, "Convertir en PDF"


1 - Supprimer ( ou mettre en commentaire) cette ligne de code
2 - Changer la sub en FUNCTION
3 - Mettre en sortie de cette fonction la variable chemsave
4 - Dans ta boucle qui fait appel à ton code de conversion ( code que tu ne nous a pas montré ) tu récupères la valeur issue de ta fonction et tu t'en sert pour générer ton message de fin.

cco86260 · Answer

Bonjour Jordane45,

Comment vas-tu ?

Donc effectivement, si je ne met pas tous les morceaux....

Donc voici la boucle qui fait appel à la procédure de conversion :

Private Sub Cmd_PDF_Click()    Dim i As Byte    'boucle sur les éléments de la ListBox    For i = 0 To ListBox1.ListCount - 1        If ListBox1.Selected(i) = True Then        feuil = ListBox1.List(i) 'nom de la feuille        Sheets(feuil).Select    ToPdf    End If    Next iEnd Sub 

Je ne reposte pas le "ToPdf"

Merci pour ton aide... (j'ai pas tout compris pour la fonction ?)

Passes une bonne après midi :)

Christian
 
--

jordane45 · Answer

Hello,
Ca va bien merci.

Voila..ça devrait te donner quelque chose de ce genre :
( A adapter à tes besoins bien entendu)


Changement de SUB en FUNCTION

Function ToPdf(nomFeuille as string)
Dim pdfjob As Object
Dim DefaultPrinter

Sheets(nomFeuille).Select

chemsave = ThisWorkbook.Sheets("MATRICE").Range("A111").Value 'tu peux changer la feuille et la cellule
'If chemsave = "" Then Exit Sub
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
'NomExcel = ThisWorkbook.Name
'NomPdf = Left(NomExcel, Len(NomExcel) - 4) & ".pdf"
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") = chemsave 'chemin destination
.cOption("AutosaveFilename") = feuil & ".pdf" 'nom de la feuille
.cOption("AutosaveFormat") = 0
.cClearCache
End With
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=32766, Copies:=1, ActivePrinter:="PDFCreator" 'on imprime la feuille active
'ThisWorkbook.PrintOut Copies:=1, ActivePrinter:="PDFCreator"
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
With pdfjob
.cDefaultprinter = DefaultPrinter
.cClearCache
.cClose
End With
Set pdfjob = Nothing
 'Dim Ret As Variant
 'ouverture du pdf
'Ret = ShellExecute(hwnd, "open", chemsave & To_PDF.ComboBox1.Value & ".pdf", "", vbNullString, 1)
ToPdf = "Votre PDF se trouve à cet emplacement: " & chemsave
End Function

Private Sub Cmd_PDF_Click()
    Dim i As Byte
    Dim msg as string
    Dim feuil  as string
    'boucle sur les éléments de la ListBox
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
          feuil = ListBox1.List(i) 'nom de la feuille
          'appel de la fonction
          msg = msg & vbLf &  ToPdf(feuil )
    End If
    Next 
'Affichage du résultat
afficheMessage = msgbox (msg, vbInformation, "Convertir en PDF")
End Sub


 
Avant de poser une question, merci de lire la charte du site.
Cordialement, Jordane

cco86260 · Answer

Merci Jordane45,

Je test ça dès ce soir, car je suis au taf... puis vu que je viens de me faire allumer... on va éviter d'envenimer la chose...


Mais merci, c'est sympas :) 

Bonne après midi

christian 
 
--

cco86260 · Answer

Bonjour Jordane45,

Donc j'ai enfin reussi à tester le code, donc quelque bug rencontré ( de ma faute ! ) ;)

Mais ce n'est pas exactement  ce que je souhaitais du à ma mauvaise explication... du moins en partie).

Lorsque je converti les rapports, il me met bien le message final... par-contre j'ai eu une mauvaise idee de vouloir un seul et meme fichier, car du coup mon fichier PDF n'a plus de nom... mais juste une extension ".pdf" Avec un seul rapport alors que j'en converti plusieurs... 
Donc changement de programme... je garde mes rapport séparés, avec un seul message quand il a fini... du style "Vos rapports ont bien été converti et se trouve a cet emplacement"...etc...

Donc là je dois juste commenter la ligne msgBox du module ToPdf() et la remettre en Sub ?

Et du coups je vais mettre une progressBar pour que le redacteur puisse voir l'avancement de la conversion car 2 rapports + le message--- ok mais 20 rapports + le message... ça commence à être long.. lol.. alors si une barre progresse... c'est mieux.. me reste à aller chercher comment que ça se passe....

A moins que d'autre solution existe... en ce cas je suis preneur...

Bonne journée à toi

Christian









 
--

Modifier à nouveau un code de convertion en PDF...

5 réponses

Votre réponse

Discussions similaires