imprimer pièces jointe

[dam3117]

Bonjour le forum,

Sub SendMail_Outlook()
ActiveWorkbook.Save
ActiveWorkbook.Activate

Dim Ol As New Outlook.Application
Dim Olmail As MailItem
Dim CurrFile As String
Dim adr, body, bodyvierge As String
Dim nomfi, nomfii As String
Dim nomfb, nomfbb As String

'Application.Dialogs(xlDialogSaveAs).Show Format(Date, "ddmmyy") & " litige " & Cells(4, 3)
'L2 = Cells(2, 12)
nomfi = Format(Cells(2, 12), "ddmmyyyy") & "-FI-" & Cells(5, 1)
nomfb = Format(Cells(2, 12), "ddmmyyyy") & "-FB-" & Cells(5, 1)
nomfbb = ThisWorkbook.Path & "\FICHES FB\" & nomfb & ".xls"
nomfii = ThisWorkbook.Path & "\FICHES FI\" & nomfi & ".xls"


If Range("C5") = "x" Then adr ="z"
If Range("C5") = "xx" Then adr = "g"
If Range("C5") = "xxx" Then adr = "hh"
If Range("C5") = "xxxx" Then adr = "kk"

body = "Vous souhaitant bonne réception."
bodyvierge = "Vous souhaitant bonne réception." & Chr(13) & "PS: Veuillez transmettre une copie." & Chr(13) & Chr(13) &


Set Ol = New Outlook.Application
Set Olmail = Ol.CreateItem(olMailItem)
With Olmail
.To = adr & ";" & Range("c2")

.BCC = "compte rendu agreage"
.Subject = "Rapport(s) du " & Range("l2") & " concernant le navire " & Range("a5")
If Range("c2") <> "" Then .body = body
If Range("c2") = "" Then .body = bodyvierge

On Error Resume Next
.Attachments.Add nomfbb
On Error Resume Next
.Attachments.Add nomfii
.Attachments.Add ActiveWorkbook.FullName
.Display
'.Send

End With
ActiveWindow.SelectedSheets.PrintOut copies:=2, Collate:=True
Workbooks.Open Filename:= _
nomfii
Windows(nomfii).PrintOut copies:=2, Collate:=True

Workbooks.Open Filename:= _
nomfbb
Windows(nomfbb).PrintOut copies:=2, Collate:=True



Windows(nomfii).Close True
Windows(nomfbb).Close True

ActiveWorkbook.Close True
End Sub


Donc je voudrais imprimer mes ou ma pièce(s) jointe et avec macro ci dessus il m'imprime uniquement le fichier ou se trouve la macro.

ce que je souhaite c'est qu'il m'imprime toutes les pièces jointe (je peux avoir de une à trois pièces jointe)

 

[Mytå]

Re : imprimer pièces jointe

Salut le forum

La lecture serait plus aisé, si tu éditais ton message

Aller en mode avancé » Sélectionne le code de la macro » Clique sur l'icone #

Mytå

 

[dam3117]

Re : imprimer pièces jointe

Bonjour,

Ma macro marche nickel jusqu’à ActiveWindow.SelectedSheets.PrintOut copies:=2, Collate:=True
cdt
Dam

 

[dam3117]

Re : imprimer pièces jointe

Bonjour à tous,

Voila lorsque j'ai au moins deux pièces jointe elle fonctionne nickel.

Mais avec une seule PJ ça bug à ce niveau
Workbooks.Open Filename:= _
nomfbb


erreur d'execution 1004 chemin introuvable... Normal le fichier n’existe pas

merci
dam

Sub SendMail_Outlook()
Range("a5").Select
ActiveWorkbook.Save
ActiveWorkbook.Activate

Dim Ol As New Outlook.Application
Dim Olmail As MailItem
Dim CurrFile As String
Dim adr, body, bodyvierge As String
Dim nomfi, nomfii As String
Dim nomfb, nomfbb As String

'Application.Dialogs(xlDialogSaveAs).Show Format(Date, "ddmmyy") & " litige " & Cells(4, 3)
'L2 = Cells(2, 12)
nomfi = Format(Cells(2, 12), "ddmmyyyy") & "-FI-" & Cells(5, 1)
nomfb = Format(Cells(2, 12), "ddmmyyyy") & "-FB-" & Cells(5, 1)
nomfbb = ThisWorkbook.Path & "\FICHES FB\" & nomfb & ".xls"
nomfii = ThisWorkbook.Path & "\FICHES FI\" & nomfi & ".xls"


If Range("C5") = "x" Then adr ="z"
If Range("C5") = "xx" Then adr = "g"
If Range("C5") = "xxx" Then adr = "hh"
If Range("C5") = "xxxx" Then adr = "kk"

body = "Bonjour,"
bodyvierge = "Bonjour," & Chr(13) & Chr(13) & "Bonne réception du "


Set Ol = New Outlook.Application
Set Olmail = Ol.CreateItem(olMailItem)
With Olmail
.To = adr & ";" & Range("c2")

.BCC = "compte rendu agreage"
.Subject = "Rapport(s) du " & Range("l2") & " concernant le navire " & Range("a5")
If Range("c2") <> "" Then .body = body
If Range("c2") = "" Then .body = bodyvierge

On Error Resume Next
.Attachments.Add nomfbb
On Error Resume Next
.Attachments.Add nomfii
.Attachments.Add ActiveWorkbook.FullName
.Display
'.Send

End With

ActiveWindow.SelectedSheets.PrintOut copies:=2, Collate:=True

On Error GoTo SUITE1

Workbooks.Open Filename:= _
nomfii

ActiveWindow.SelectedSheets.PrintOut copies:=2, Collate:=True
ActiveWorkbook.Close True
ActiveWorkbook.Close True
Exit Sub
SUITE1:
On Error GoTo SUITE
Workbooks.Open Filename:= _
nomfbb
ActiveWindow.SelectedSheets.PrintOut copies:=3, Collate:=True

ActiveWorkbook.Close True
ActiveWorkbook.Close True
Exit Sub
SUITE:
ActiveWorkbook.Close True
ActiveWorkbook.Close True



End Sub