Bonjour,
Est-il possible d'ouvrir une pièce jointe (une image principalement) par macro et d'imprimer par macro ce document ?
Malgré mes différentes recherches, je sèche à trouver une réponse à ce problème.
Franck
Bonjour,
Est-il possible d'ouvrir une pièce jointe (une image principalement) par macro et d'imprimer par macro ce document ?
Malgré mes différentes recherches, je sèche à trouver une réponse à ce problème.
Franck
Bonjour,
tu veux l'ouvrir ou l'imprimer ?
mais oui c'est possible
Merci pour votre intervention rapide.
En fait je veux l'ouvrir et ensuite l'imprimer mais par macro.
Finalement, j'ai pratiquement réussi.
J'aurais voulu que l'image se sauvegarde via PDFcrator avec un nom prédonné et à un emplacement défini mais c'est déjà un bon début avec ça.
Je vous donne le code (plusieurs codes trouvés et adaptés à mon besoin) si ça peut aider d'autres personnes, il permet de pouvoir imprimer des pièces jointes via PDFCreator en sélectionnant cette imprimante et transfère le mail à qui vous souhaitez transmettre le mail en changeant l'objet du mail.
Mon code :
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
Sub ShellImprime(fichier As String)
ShellExecute 0, "print", fichier, "", "C:\temp\", 0
End Sub
Sub ImprimePDF()
'---------------------------------------------------------------------------------------
' Procédure : ImprimePDF
' Auteur : Franck MULLER
' Date : 17/02/2016
'---------------------------------------------------------------------------------------
'
Dim blnEdit As Boolean
Dim Oitem, myAttachments As Object
Dim Ol As Outlook.Application
Dim myItem, objNewMail As MailItem
Dim I, y, z As Integer
Dim myInspector As Outlook.Inspector
Dim sFile As String
bPath = "C:\temp\"
If Dir(bPath, vbDirectory) = vbNullString Then
MkDir bPath
End If
Set myInspector = Application.ActiveInspector
If Not TypeName(myInspector) = "Nothing" Then
If TypeName(myInspector.CurrentItem) = "MailItem" Then
Set myItem = myInspector.CurrentItem
Set myAttachments = myItem.Attachments
On Error GoTo OLMailErr
Set objNewMail = myInspector.CurrentItem.Reply
objNewMail.Display
With objNewMail
.To = votreadressemail
.Subject = votreobjetdumail
'Joindre les pièces, s'il y en a
For I = 1 To myItem.Attachments.Count
Call Impression
If InStr(1, myAttachments.Item(I).FileName, ".JPG") > 1 Or InStr(1, myAttachments.Item(I).FileName, ".jpg") > 1 Or InStr(1, myAttachments.Item(I).FileName, ".tiff") > 1 Then
sFile = bPath & myAttachments.Item(I).FileName
myAttachments.Item(I).SaveAsFile sFile
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
pdfSave = bPath & myAttachments.Item(I).FileName
MsgBox "Pour que le fichier soit transformé en PDF, cliquer sur le bouton OK ci-dessous UNIQUEMENT lorsque vous aurez enregistré sur votre bureau la pièce jointe."
Kill pdfSave 'supprime le fichier
End If
Next I
If blnEdit Then
.Display
End If
End With
MsgBox "Opération terminée"
Set objNewMail = Nothing
Exit Sub
Else
OLMailErr:
MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
Exit Sub
End If
End If
End Sub
Sub Impression()
'Nom de l'imprimante tel qu'écrit dans le panneau
'de configuration de Windows
Dim strComputer As String, objWMIService As Object
Dim colInstalledPrinters As Object, objPrinter As Object
Dim X As Variant, Arr()
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colInstalledPrinters = _
objWMIService.execQuery("Select * from Win32_Printer")
For Each objPrinter In colInstalledPrinters
a = a + 1
Message = Message & a & " - Nom: " & objPrinter.Name & vbCrLf
ReDim Preserve Arr(1 To a)
Arr(a) = objPrinter.Name
Next
X = InputBox("Insérer le chiffre correspondant à l'imprimante PDFCreator." & _
vbCrLf & Message, "Choisissez une imprimante")
If X = False Then Exit Sub
If X < 1 Or X > UBound(Arr) Then
MsgBox "Votre numéro du choix de l'imprimante est " & _
"inexistant.", vbCritical + vbOKOnly, "Procédure avortée"
Exit Sub
End If
Call Imprimante_Par_Défaut(Arr(X))
End Sub
'-----------------------------------------
Sub Imprimante_Par_Défaut(Nom_Imprimante As Variant)
Dim strComputer As String, objWMIService As Object
Dim colInstalledPrinters As Object, objPrinter As Object
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colInstalledPrinters = _
objWMIService.execQuery("Select * from Win32_Printer Where Name = '" & Nom_Imprimante & "'")
For Each objPrinter In colInstalledPrinters
objPrinter.SetDefaultPrinter
Next
End Sub
et il se passe quoi entre l'ouverture et l'impression ?
en fait cela dépend beaucoup de ton type de PJ cela sera différent entre une image, un pdf et un document office.
si c'est juste l'ouvrir pour l'imprimer, en fait il faut l'enregistrer dans un dossier temporaire et l'imprimer
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11 Private Sub PrintTo() 'Oliv 22 fev 2007 Dim wshShell, SetdefaultPrinter LeFichier = "C:\Users\O\Pictures\cuicine_1.jpg" LaPrinter = "PDFCreator" Set wshShell = CreateObject("WScript.Shell") SetdefaultPrinter = "rundll32 shimgvw.dll,ImageView_PrintTo """ & LeFichier & """" & Chr(32) & """" & LaPrinter & """" wshShell.Run SetdefaultPrinter, 0, False Set wshShell = Nothing End Sub
En gros, j'ai, dans un mail, x pièces jointes au format image.
Je transfère le mail et je joins à ce mail les pièces jointes au format PDF.
Jusqu'au lancement de PDFCreator, pas de souci.
Le problème dans les 2 cas, le code que j'ai mis et ton code (merci d'ailleurs, il est beaucoup moins lourd que celui que j'ai mis), c'est que l'impression n'est pas automatique et qu'avec PDFCreator nous ne pouvons pas enregistrer directement le fichier dans un dossier en le renommant et l'ajouter ensuite au mail transféré.
Il y a plusieurs façon de faire.
déjà il faut definir comment est lancée la macro
- Manuellement ?
- Via une règle ?
- Autre ?
ensuite ce que tu veux faire avec tes PJ
convertir toutes les images en PDF
Certaines
que faire des autres PJ ?
faire 1 pdf par image ou 1 pdf par Email
etc
PDFCREATOR permet effectivement cela quelle version avez vous ? il y a d'autre solutions sans PDFCREATOR
La macro est lancée manuellement via un bouton de la barre d'outils d'Accès Rapide.
Dans le code que j'ai mis au-dessus, les pièces jointes sont enregistrées à un endroit, pour être ensuite imprimées en PDF, ajoutées au mail transféré et enfin, elles sont supprimées de cet endroit.
Je définis dans le code les extensions que je veux convertir.
Faire un PDF par image me convient très bien.
Il s'agit de PDFCreator 1.6.0.
3 façons d'y arriver
- utiliser PDFCREATOR (NE PAS DEPASSER LA VERSION 1.7.3 ) tu trouveras tout ce qu'il faut sur les post de kiki29
- utiliser pdfforge contenu dans PDFCREATOR jusqu'à la version 1.7.3
- utiliser WORD, tu importes dans word ton image, insères un saut de page, image suivante saut de page , etc ,... puis tu fais enregistrez-sous en PDF
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7 ActiveDocument.ExportAsFixedFormat OutputFileName:="C:\exemple.pdf", _ ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _ wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _ Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _ CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _ BitmapMissingFonts:=True, UseISO19005_1:=False "
ajoutes un DOEVENTS avant de supprimer ton fichier, ou supprimes tout à la fin, car des fois ça coince.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2DOEVENTS Kill pdfSave 'supprime le fichier
J'ai finalement réussi à faire la macro avec PDFCreator.
Je la mets ici pour ceux qui souhaitent l'utiliser :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121 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 Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 64-Bit 'Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Public Sub Pause(intSeconds As Variant) ' Comments: Waits for a specified number of seconds ' Params : intSeconds Number of seconds to wait ' Source : Total Visual SourceBook On Error GoTo PROC_ERR Dim datTime As Date datTime = DateAdd("s", intSeconds, Now) Do ' Yield to other programs (better than using DoEvents which eats up all the CPU cycles) Sleep 100 DoEvents Loop Until Now >= datTime PROC_EXIT: Exit Sub PROC_ERR: MsgBox "Error: " & Err.Number & ". " & Err.Description, , "Pause Method" Resume PROC_EXIT End Sub Sub ShellImprime(fichier As String) ShellExecute 0, "print", fichier, "", "C:\temp\", 0 End Sub Sub ImprimePDF() Dim blnEdit As Boolean Dim Oitem, myAttachments As Object Dim Ol As Outlook.Application Dim myItem, objNewMail As MailItem Dim I, y, z As Integer Dim myInspector As Outlook.Inspector Dim sFile, OutputFilename As String Dim wshShell, SetdefaultPrinter, GetDefaultPrinter Dim PDFCreator1 As PDFCreator.clsPDFCreator Dim c As Long GED.Show LaPrinter = "PDFCreator" bPath = "C:\temp\" a = nom_donne_au_PDF If Dir(bPath, vbDirectory) = vbNullString Then MkDir bPath End If Set myInspector = Application.ActiveInspector If Not TypeName(myInspector) = "Nothing" Then If TypeName(myInspector.CurrentItem) = "MailItem" Then Set myItem = myInspector.CurrentItem Set myAttachments = myItem.Attachments On Error GoTo OLMailErr Set objNewMail = myInspector.CurrentItem.Reply objNewMail.Display With objNewMail .To = votreadressemail .Subject = votreobjetdumail 'Joindre les pièces, s'il y en a For I = 1 To myItem.Attachments.Count 'Call Impression If InStr(1, myAttachments.Item(I).Filename, ".JPG") > 1 Or InStr(1, myAttachments.Item(I).Filename, ".jpg") > 1 Or InStr(1, myAttachments.Item(I).Filename, ".tiff") > 1 Then 'indiquer les extensions qui seront convertis en PDF sFile = bPath & a & "_" & I & "." & Mid(myAttachments.Item(I).Filename, InStrRev(myAttachments.Item(I).Filename, ".") + 1) myAttachments.Item(I).SaveAsFile sFile fichier_pdf = bPath & a & "_" & I & ".pdf" Set PDFCreator1 = New clsPDFCreator With PDFCreator1 .cStart "/NoProcessingAtStartup" .cOption("UseAutosave") = 1 .cOption("UseAutosaveDirectory") = 1 .cOption("AutosaveDirectory") = "C:\temp" .cOption("AutosaveFilename") = a & "_" & I .cOption("AutosaveFormat") = 0 ' 0 = PDF DefaultPrinter = .cDefaultPrinter .cDefaultPrinter = "PDFCreator" .cClearCache 'myAttachments.Item(I).SaveAsFile sFile Set wshShell = CreateObject("WScript.Shell") SetdefaultPrinter = "rundll32 shimgvw.dll,ImageView_PrintTo """ & sFile & """" & Chr(32) & """" & LaPrinter & """" wshShell.Run SetdefaultPrinter, 0, False Set wshShell = Nothing 'ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0 DoEvents .cPrinterStop = False OutputFilename = PDFCreator1.cOutputFilename .cOption("UseAutosave") = 0 .cOption("UseAutosaveDirectory") = 0 End With Pause 10 If OutputFilename = "" Then MsgBox "Création du fichier PDF en cours." & vbCrLf & vbCrLf & _ "Une erreur s'est produite : Temps imparti !", vbExclamation + vbSystemModal End If .Attachments.Add (fichier_pdf) Kill sFile 'supprime le fichier Kill fichier_pdf 'supprime le fichier End If Next I If blnEdit Then .Display End If End With MsgBox "Opération terminée" Set objNewMail = Nothing Exit Sub Else OLMailErr: MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description Exit Sub End If End If End Sub
Super !
Avec PDFCREATOR je mettais cela pour attendre la fin de la génération en pdf (où tu as le pause 10, car 10 secondes ca peut être long ou trop court)
Tu devrais peut être mettre un Doevents après .Attachments.Add (fichier_pdf) ou un pause 1 juste avant les suppressions de fichiers
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4 'Wait until the PDF file shows up then release the objects Do Until Dir(fichier_pdf ) <> "" DoEvents Loop
Merci Oliv- pour ta disponibilité, j'ai rajouté tes 2 suggestions.
Encore merci, bonne journée et bon week-end.
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager