Résolu Macro excel et pdfcreator

Ludovic 500

Grand Maître
#1
Bonjour à tous,

j'ai un petit soucis avec pdfcreator depuis les macros excel vba :

j'utilise excel pour renseigner différents champs, dont des relevés de mesures, d'où sont tirés des graphiques sur différentes feuilles, ainsi qu'une partie rapport (texte mis en forme), toujours sous excel.

une macro me permet de mettre en forme une partie du rapport : certains mots devant être mis en Italque dans une cellule ; celle-ci fonctionne à merveille grâce à zeb.

la seconde me permet d'imprimer à la volée toute les feuilles devant constituer le rapport papier, et fonctionne également, je me suis débrouillé tout seul pour celle-ci.

la troisième me permet de créer une copie renommée du fichier renseigné, en cherchant l'existence ou non du chemin d'enregistrement, et à défaut de la créer, puis de fermer le nouveau fichier et de revenir au fichier initial vierge.

en fin, la dernière macro qui me pose soucis concerne l'utilisation de pdfcreator : j'ai réussi sur la première partie de ce que je veux faire : convertir les mêmes feuilles à imprimer en les regroupant en un seul fichier, après avoir également collé un jpeg de signature.
là où je coince, c'est sur la seconde partie : après avoir fusionner les différentes feuilles dans l'ordre d'impression, je veux ajouter un dernier fichier au format déjà pdf, dont le nom dépend d'une cellule dont le résultat dépend des renseignements saisis, et fusionner ces deux nouveaux fichiers en file d'attente pour au final ne créer qu'un seul pdf complet.

je voudrais également que ce pdf ne puisse que être lu et/ou imprimé, qu'il ne soit pas possible de sélectionner (et donc copier en vue de modification) du texte ou quoique ce soit dessus. Mais ça ce sera pour la suite.

je vous joins donc le code de ma 4ème macro, peut-être pas très propre, mais qui fonctionne pour la première partie du problème, la nouvelle instruction devant être placée entre les lignes 97 & 98.

j'ai essayé avec .cAddPrintJob, mais quelque chose n'est pas codé correctement, c'est pourquoi je vous demande un peu d'aide et surtout d'explication

par avance merci

[cpp]Sub Création_pdf()

' Création_pdf Macro
' Macro enregistrée le 04/10/2010 par

Sheets("Renseignements machine").Select
Dim annee As String
Dim client As String
Dim fichier As String
Dim window As String
Dim cheminannee As String
Dim cheminclient As String
Dim rapport As String
Dim test As String
Dim debut As label
Dim fin As label
Dim racc As String
Dim ps As String
Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String

test = [L1].Value
If test = "" Then GoTo debut
MsgBox "NOM DU CLIENT, NUMERO DU RAPPORT OU DATE, NON RENSEIGNES, VERIFIEZ ET RE-ESSAYEZ !!!", vbOKOnly, "OUBLIS !!!"
GoTo fin

debut:

racc = [j6].Value
rapport = "E:\Dossiers Clients\Modèles de documents\Rapport Standard MMT.xls"
annee = [i46].Value
client = [b5].Value
fichier = [i45].Value
window = [i49].Value
cheminannee = [i47].Value
cheminclient = [i48].Value
If Dir(cheminannee, vbDirectory) = "" Then 'Création du dossier ANNEE si n'existe pas
MkDir cheminannee
End If
If Dir(cheminclient, vbDirectory) = "" Then 'Création du dossier CLIENT si n'existe pas
MkDir cheminclient
End If



sPDFName = [b31].Value & ".pdf"
sPDFPath = [i50].Value

Set pdfjob = New PDFCreator.clsPDFCreator
With pdfjob
.cDefaultPrinter = True

If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Il y a des documents dans la file d'attente, purger la relancer la commande", vbCritical + _
vbOKOnly, "PrtPDFCreator"
Exit Sub
End If


Sheets("Rapport").Select 'Insertion du jpeg de la signature
Range("C79").Select
ActiveSheet.Pictures.insert( _
"E:\Dossiers Clients\Modèles de documents\SIGNATURE REDIM.jpg").Select
Selection.ShapeRange.IncrementLeft 60#
Selection.ShapeRange.ScaleWidth 6.64, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 6.64, msoFalse, msoScaleFromTopLeft

Application.ActivePrinter = "PDFCreator sur Ne00:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
"PDFCreator sur Ne00:", Collate:=True
Sheets("AXE X").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Sheets("AXE Y").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Sheets("AXE Z").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Sheets("Volume 1").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Sheets("Volume 2").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Sheets("Volume 3").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Sheets("Volume 4").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Sheets("Equerrages").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Do Until pdfjob.cCountOfPrintjobs = 9 'attent que l'impression soit dans la file d'attente de pdf créator
DoEvents
Loop

.cCombineAll
Do Until pdfjob.cCountOfPrintjobs = 1 'attent que la fusion des feuilles est complète
DoEvents
Loop

.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF

.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0 'attent que la fusion des feuilles est complète
DoEvents
Loop
.cClearCache
.cClose

End With

Sheets("Rapport").Select
Range("C79").Select
ActiveSheet.Pictures.Select
Selection.Delete
Sheets("Renseignements machine").Select

fin:

End Sub[/cpp]


ps : il reste dans ce code une partie de la 3ème macro qui me permet de vérifier l'existence de l'arborescence ou va être enregistrer le pdf (au même endroit que le fichier excel)

edit : à savoir que ce que je veux faire fonctionne manuellement
 

zeb

Modérateur
#2
Oulala, que ce code est laid. Pouah !
Salut Ludo. C'est moi qui t'ai appris à faire ça ?

Tant de Select :pfff:
Et de fonctions différentes qui se mélangent :pfff:

Qu'importe.

Ta question, c'est donc, comment assembler des fichiers différents dans une seule impression finale. C'est ça ?

Ben, c'est simple, il te suffit d'imprimer tous les documents que tu veux à la suite, entre la ligne
Code:
cPrinterStop = True
et les lignes
Code:
cCombineAll
..
cPrinterStop = False
Hein !? Tu ne sait pas imprimer un document quelconque ? C'est pourtant facile. On demande à Windows de le faire. [:spamafote]
On utilise pour ce faire l'API ShellExecute :
Code:
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Dim rc As Long
rc = ShellExecute(0, "print", fichier, "", "", 0)
If 1 < rc And rc <= 32 Then Debug.Print "Un truc c'est mal passé"
 

zeb

Modérateur
#3
Cadeau :
Code:
Option Explicit

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
    ByVal hWnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long
  
Function FileExists(ByVal sFileName As String) As Boolean
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FileExists = FSO.FileExists(sFileName)
End Function

Function WorksheetExists(ByVal Name As String, Optional wb As Workbook) As Boolean
    Dim ws As Worksheet
       
    WorksheetExists = False
    If wb Is Nothing Then Set wb = ActiveWorkbook
   
    For Each ws In wb.Worksheets
        If ws.Name = Name Then
            WorksheetExists = True
            Exit For
        End If
    Next
End Function

Function GetFilePath(ByVal FileName As String) As String
    Dim i As Integer
    
    For i = Len(FileName) To 1 Step -1
        Select Case Mid(FileName, i, 1)
            Case ":": GetFilePath = Left(FileName, i): Exit For
            Case "\": GetFilePath = Left(FileName, i - 1): Exit For
        End Select
    Next
End Function

Function GetFileName(ByVal FileName As String) As String
    Dim i As Integer
    
    GetFileName = FileName
    For i = Len(FileName) To 1 Step -1
        If Mid(FileName, i, 1) = ":" Or _
           Mid(FileName, i, 1) = "\" _
        Then
            GetFileName = Mid(FileName, i + 1)
            Exit For
        End If
    Next
End Function

Sub CollateVariousSourcesToPDF(ByVal PDFname As String, ParamArray prm())
    Dim pdf      As PDFCreator.clsPDFCreator
    Dim ws       As Worksheet
    Dim closepdf As Boolean
    Dim i        As Integer
    Dim counter  As Integer
    Dim rc       As Long

    Set pdf = New PDFCreator.clsPDFCreator
    
    closepdf = pdf.cStart("/NoProcessingAtStartup")
    pdf.cDefaultPrinter = True
    pdf.cOption("UseAutosave") = 1
    pdf.cOption("UseAutosaveDirectory") = 1
    pdf.cOption("AutosaveDirectory") = GetFilePath(PDFname)
    pdf.cOption("AutosaveFilename") = GetFileName(PDFname)
    pdf.cOption("AutosaveFormat") = 0
    pdf.cClearCache
    
    For i = LBound(prm) To UBound(prm)
        Select Case TypeName(prm(i))
            Case "Worksheet"
                prm(i).PrintOut
                Do: DoEvents: Loop Until pdf.cCountOfPrintjobs >= i + 1
            Case "Integer"
                Worksheets(prm(i)).PrintOut
                Do: DoEvents: Loop Until pdf.cCountOfPrintjobs >= i + 1
            Case "String" '// Nom de feuille ou nom de fichier ?
                If WorksheetExists(prm(i)) Then
                    prm(i).PrintOut
                    Do: DoEvents: Loop Until pdf.cCountOfPrintjobs >= i + 1
                Else
                If FileExists(prm(i)) Then
                    rc = ShellExecute(0, "print", prm(i), "", "", 0)
                    If 1 < rc And rc <= 32 Then
                        Debug.Print "Un truc c'est mal passé avec l'impression."
                    Else
                        Do: DoEvents: Loop Until pdf.cCountOfPrintjobs >= i + 1
                    End If
                Else
                    Debug.Print "Bizarre : '" & prm(i) & "' non trouvé."
                End If
                End If
            Case Default
                Debug.Print "Bizarre : Le type '" & TypeName(prm(i)) & "' a été utilisé."
        End Select
    Next
    
    ' // Assemblage
    pdf.cCombineAll
    For i = 0 To 1000: DoEvents: Next
    Do: DoEvents: Loop Until pdf.cCountOfPrintjobs <= 1
    
    ' // C'est parti
    pdf.cPrinterStop = False
    For i = 0 To 1000: DoEvents: Next
    Do: DoEvents: Loop Until pdf.cCountOfPrintjobs = 0
    
    ' // Mr Propre
    pdf.cClearCache
    If closepdf Then pdf.cClose
End Sub

Sub Test_PDF()
    CollateVariousSourcesToPDF "C:\Documents and Settings\Ludovic 500\Mes Documents\test.pdf", Worksheets(1), 2, "C:\Documents and Settings\Ludovic 500\Mes Documents\Page_de_fin.pdf"
End Sub
 

Ludovic 500

Grand Maître
#4
Bonjour Zeb, je savais que tu allais dire ça ;)

non, non, ce code, ce n'est pas toi qui m'a appris à faire ça, :lol:, il vient pour partie d'une macro enregistrée par excel (pour l'impression des onglets) retravaillée pour imprimer sur pdfcreator, et de différentes recherche sur le net (google) pour la partie utilisation de pdfcreator, et le principal pour moi, c'est que ça fonctionne.

je te remercie pour ton aide précieuse, je ne vais pas recopier bêtement le code que tu m'as fourni, mais essayer de comprendre ce qu'il fait, et si j'ai besoin, je te fais signe pour plus d'explications.

je me rends compte que j'ai oublié de préciser que dans ma macro, la chaîne qui fait appel au nom du fichier pdf qui doit être joint et fusionné à la fin de l'impression des différents onglets est "racc".

autre précision, pour le pdf final, il ne faut pas que j'imprime tous les onglets, mais seulement ceux qui servent à établir le rapport de contrôle final envoyé au client ; je ne sais pas, pour le moment, si ça a une importance avec le code que tu m'offres.

à nouveau merci pour ton aide, je te tiens au courant de mes avancés, ou difficultés :sweat:
 

Ludovic 500

Grand Maître
#5
juste une question, ton code peut s'appliquer aux macros excel? je demande ça car rien qu'avec le petit code que tu me donnes en premier, j'ai une erreur de compilation qui s'affiche sur ShellExecute : n'y a-t-il pas une référence à activer dans les outils de VBA? j'ai beau chercher,je ne trouve pas d'API Windows ShellExecute :sweat:
 

zeb

Modérateur
#6
ShellExecute() est une fonction de l'API Windows. Elle est accessible à tout programme, y compris à VBA/Excel.

Par contre, elle doit être déclarée. C'est le sens de ce code :
Code:
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( .... )
Quant à ne pas trouver cette fonction dans l'API, tu as mal cherché :
http://msdn.microsoft.com/en-us/library/bb762153%28VS.85%29.aspx
 

Ludovic 500

Grand Maître
#7
tu as raison, en parcourant le dossier system32 et en sélectionnant shell32.dll, ça m'a activé la référence "Microsoft Shell Controls And Automation" qui n'était pas activée, je vais retenter avec ça maintenant :sweat:
 

zeb

Modérateur
#8
M'enfin, non, non et non ! :non:
Pas besoin d'activer cette référence.

Faut pas confondre les ActiveX et l'API :o
 

Ludovic 500

Grand Maître
#9
ben j'ai pas encore testé depuis, mais avec le code que tu m'as donné, vb me renvoie "Erreur de compilation" :(
 

Ludovic 500

Grand Maître
#10
je ne comprends pas le fonctionnement de ton code zeb, quand je lance la macro, il veux en appeler une autre? [:spamafote]

je me suis donc débrouillé en bricolant, mon truc, très certainement très laid pour un puriste, fonctionne.

cependant, j'ai un soucis lors de la fusion complète des fichiers en un seul avant création du pdf, arrivé à peu près à 70% de la fusion, excel affiche une boite informant qu'il "attend la fin de l'exécution OLE d'une autre application", et je me suis aperçu qu'il ne faut pas cliquer sur OK tant que pdfcreator n'a pas terminé la fusion des files d'attente, sinon il y a perte de file d'attente justement, et en plus le fichier final n'est pas créé.

j'ai tenté de multiplier les boucle "doevents", ou encore d'insérer des temporisations, rien n'y fait.

comment faire pour que l'attente d'excel soit allongée pendant l'exécution d'un OLE, ou encore que le temps imparti à un OLE soit plus long avant la "reprise en main" d'excel?
 

Ludovic 500

Grand Maître
#11
bon j'ai résolu mon soucis ci-dessus à force de chercher (merci google), et c'était ton c** comme soluce (enfin ça fonctionne pour mon cas) :

Code:
 Application.DisplayAlerts = False
me reste plus qu'à revenir sur le code de Zeb pour comprendre le fonctionnement ;)
 

zeb

Modérateur
#12
La façon de faire avec PDFCreator n'est vraiment pas très propre.
C'est long, peu fiable, et surtout on risque de bloquer une application avec une autre.

Je te propose de jeter un oeil à ce que nous propose l'ami gougueule :
http://www.google.com/search?q=command+line+pdf+tools

Avec les outils en ligne de commande, tu pourras enchaîner tes fusions de façon bien plus propre.
 

Ludovic 500

Grand Maître
#13
des lignes de commande dans une macro excel?
 

zeb

Modérateur
#14
Oui, bien sûr, avec la commande Shell.
 

Ludovic 500

Grand Maître
#15
ah bah oui, bien sûr, j'imaginais l'ouverture de la fenêtre dos ou un truc du genre :sweat:
 

Ludovic 500

Grand Maître
#16
Meilleure réponse
finalement un truc bien plus simple, et qui fonctionne, toujours avec pdfcreator, et j'ai même trouvé le code qui va bien pour protéger les documents...

[cpp]Sub Création_PDF()
'
' Création_PDF Macro
' Macro enregistrée le 25/10/2010 par Ludovic 500
'
Dim TEST As String
Dim début As Label
Dim fin As Label
Dim cheminannee As String
Dim cheminclient As String
Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFPath As String
Dim sPDFName As String
Dim annee As String
Dim initiales As String
Dim pass As String

TEST = Sheets("Renseignements Machine").Range("L1").Value
cheminannee = Sheets("Renseignements Machine").Range("i47").Value
cheminclient = Sheets("Renseignements Machine").Range("i48").Value
annee = Sheets("Renseignements Machine").Range("i46").Value
initiales = Sheets("Renseignements Machine").Range("m21").Value
pass = "Ma Société" & annee & initiales & Round(1000000 * Rnd(), 0)

Sheets("Renseignements Machine").Range("j55") = pass

If TEST = "" Then GoTo début
MsgBox "NOM DU CLIENT, NUMERO DU RAPPORT OU DATE, NON RENSEIGNES, VERIFIEZ ET RE-ESSAYEZ !!!", vbOKOnly, "OUBLIS !!!"
GoTo fin

début:

Application.StatusBar = "Merci de patienter"
Application.DisplayAlerts = False

If Dir(cheminannee, vbDirectory) = "" Then 'Création du dossier ANNEE si n'existe pas
MkDir cheminannee
End If

If Dir(cheminclient, vbDirectory) = "" Then 'Création du dossier CLIENT si n'existe pas
MkDir cheminclient
End If

sPDFPath = Sheets("Renseignements Machine").Range("i50").Value
sPDFName = Sheets("Renseignements Machine").Range("B31").Value & ".pdf"

Set pdfjob = New PDFCreator.clsPDFCreator
With pdfjob

If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Il y a des documents dans la file d'attente, purger la, fermer pdfcreator puis relancer la commande", vbCritical + _
vbOKOnly, "PrtPDFCreator"
.cClearCache
Exit Sub
End If
.cDefaultPrinter = True
.cOption("UseAutosave") = 1 'enregistrement automatique du fichier
.cOption("UseAutosaveDirectory") = 1 'enregistrement automatique du fichier dans le répertoire spécifié
.cOption("AutosaveDirectory") = sPDFPath 'nom du répertoire de sauvegarde
.cOption("AutosaveFilename") = sPDFName 'nom du fichier de sauvegarde
.cOption("AutosaveFormat") = 0 'format de création : 0 = PDF
.cOption("AutosaveStartStandardProgram") = 1 'ouverture du programme par défaut pour visualiser le fichier
'les lignes suivantes sont requises pour régler les paramètres de sécurité
.cOption("PDFUseSecurity") = 1 'active la sécurité
.cOption("PDFOwnerPass") = 1 'active le mot de passe propriétaire
.cOption("PDFOwnerPasswordString") = pass 'mot de passe propriétaire
'les lignes suivantes servent à régler les autorisations/interdictions de l'utilisateur
.cOption("PDFDisallowCopy") = 1 'n'autorise pas la copie
.cOption("PDFDisallowModify") = 1 'n'autorise pas la modification
.cOption("PDFDisallowModifyContents") = 1 'n'autorise pas la modification du contenu
.cOption("PDFDisallowModifyComments") = 1 'n'autorise pas la modification des commentaires
.cOption("PDFDisableCaption") = 1 'n'autorise pas la sélection du contenu par la souris
'les lignes suivantes forcent un utilisateur à saisir un mot de passe avant d'ouvrir le fichier
' pour l'activer, enlever l'apostrophe au début des 2 lignes suivantes
'.cOption("PDFUserPass") = 1
'.cOption("PDFUserPasswordString") = pass
.cPrinterStop = True

MsgBox "Veuillez patienter, la création du document pdf est très longue!!!", vbOKOnly, "WAIT & SEE"
Application.StatusBar = "Merci de patienter & password =" & pass

Sheets("Rapport").Select 'Insertion du jpeg de la signature
Range("C79").Select
ActiveSheet.Pictures.Insert( _
"E:\Dossiers Clients\Modèles de documents\SIGNATURE REDIM.jpeg").Select
Selection.ShapeRange.IncrementLeft 60#

Application.ActivePrinter = "PDFCreator sur Ne00:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
"PDFCreator sur Ne00:", Collate:=True

'remarque : les boucles "Do Until" suivi de "Loop" sont très importantes, car sans elles, certaines feuilles passent avant
'les autres en fonction de leur taille en ko, et au final le document créé est dans le désordre

Do Until pdfjob.cCountOfPrintjobs = 1 'attent que l'impression soit dans la file d'attente de pdf créator
DoEvents
Loop
Range("c79").Select
ActiveSheet.Pictures.Select
Selection.Delete
Range("c9").Select

Sheets("AXE X").Select
Range("A1").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Do Until pdfjob.cCountOfPrintjobs = 2 'attent que l'impression soit dans la file d'attente de pdf créator
DoEvents
Loop

Sheets("AXE Y").Select
Range("A1").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Do Until pdfjob.cCountOfPrintjobs = 3 'attent que l'impression soit dans la file d'attente de pdf créator
DoEvents
Loop

Sheets("AXE Z").Select
Range("A1").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Do Until pdfjob.cCountOfPrintjobs = 4 'attent que l'impression soit dans la file d'attente de pdf créator
DoEvents
Loop

Sheets("Volume 1").Select
Range("A1").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Do Until pdfjob.cCountOfPrintjobs = 5 'attent que l'impression soit dans la file d'attente de pdf créator
DoEvents
Loop

Sheets("Volume 2").Select
Range("A1").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Do Until pdfjob.cCountOfPrintjobs = 6 'attent que l'impression soit dans la file d'attente de pdf créator
DoEvents
Loop

Sheets("Volume 3").Select
Range("A1").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Do Until pdfjob.cCountOfPrintjobs = 7 'attent que l'impression soit dans la file d'attente de pdf créator
DoEvents
Loop

Sheets("Volume 4").Select
Range("A1").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Do Until pdfjob.cCountOfPrintjobs = 8 'attent que l'impression soit dans la file d'attente de pdf créator
DoEvents
Loop

Sheets("Equerrages").Select
Range("A1").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Do Until pdfjob.cCountOfPrintjobs = 9 'attent que l'impression soit dans la file d'attente de pdf créator
DoEvents
Loop

Sheets("Renseignements machine").Select
ActiveSheet.Unprotect
Range("D1:F8").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("D1").Select
With Selection.Interior
.ColorIndex = 44
.Pattern = xlSolid
End With
Range("D1") = "PATIENCE, LA DISPARITION DE CE MESSAGE INDIQUE QUE LA CREATION EST TERMINEE"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

.cAddPrintjob ("E:\Dossiers Clients\Modèles de documents\Raccordements\" & Sheets("Renseignements machine").Range("j5").Value & ".ps")
Do Until pdfjob.cCountOfPrintjobs = 10 'attent que l'impression soit dans la file d'attente de pdf créator
DoEvents
Loop

.cCombineAll 'fusion de tous les documents dans l'ordre d'arrivée
Do Until pdfjob.cCountOfPrintjobs = 1 'attent que la fusion des feuilles est complète
DoEvents
Loop

.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0 'attent que "l'impression" soit terminée
DoEvents
Loop

.cClearCache
.cDefaultPrinter = False
.cClose
End With

Sheets("Renseignements machine").Select
ActiveSheet.Unprotect
Range("D1:F8").Select
Selection.ClearContents
Selection.Interior.ColorIndex = xlNone
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.UnMerge
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ActivePrinter = "HP Deskjet 5900 Series sur Ne03:"
Application.StatusBar = ""
Application.DisplayAlerts = True
MsgBox "CREATION DU RAPPORT ELECTRONIQUE TERMINEE", vbOKOnly, sPDFName
Range("B5").Select

fin:
End Sub

[/cpp]

c'est peut être toujours pas très beau, mais ça fonctionne, et donne le résultat que je voulais
 

zeb

Modérateur
#17
C'est effectivement très moche. :o
Mais si c'est la meilleure des solutions, je vote pour ! ;)
 

zeb

Modérateur
#18
Meilleure réponse sélectionnée par zeb.
 

Ludovic 500

Grand Maître
#19
:lol: :lol:

merci, car moi je ne peux pas sélectionner ma solution comme meilleure soluce.

merci quand même de t'être penché sur mon problème zeb, :merci: , il y a peut-être des parties de mon code qui pourront servir à d'autres :D
 

zeb

Modérateur
#20
Pour choisir soi-même sa soluce, il suffit de demander. :o
Ou de me laisser faire ;)
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Staff en ligne
  • job31
    Admin tout frippé
Membres en ligne
  • Matiouz13
  • vaelis
  • Misterybean
  • pazue
  • job31
  • Ander 666
  • barney7
  • KybrOo
Derniers messages publiés
Statistiques globales
Discussions
863 587
Messages
8 038 103
Membres
1 574 091
Dernier membre
ishaqsoft
Partager cette page
Haut