Bonjour a tous après plusieurs test et heures de recherche je vient demander de l'aide j ai un code qui me crée un fichier PDF avec plusieurs feuilles qui correspondent à plusieurs onglet dans mon fichier je ne trouve pas comment continuer ce code pour qu il me crée un mail avec ce fichier en pièce jointe ou les destinataire sont prise dans une cellule de ma feuille sommaire je sais j en demande beaucoup mais je débute en vba et donc je suis gourmand merci de votre aide .
Un autre code qui fonctionne pour les mail mais qui ne me permet de sectionner plusieurs feuilles de mon classeur la solution est peut être plus dans ce code merci de votre aide.
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 Sub envoiverifachat() Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim destwb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim OutApp As Object Dim OutMail As Object Dim S As Shape Dim sNomFic As String, sRep As String, WshShell As Object With Application .ScreenUpdating = False .EnableEvents = False End With ' Créer une instance Windows Script pour retrouver le chemin du bureau Set WshShell = CreateObject("WScript.Shell") sRep = WshShell.SpecialFolders("Desktop") Set WshShell = Nothing ' Définit le nom du fichier à enregistrer sNomFic = "vérif achat.pdf" ' Enregistrer la feuille en PDF Sheets("verif achat").ExportAsFixedFormat Type:=xlTypePDF, Filename:=sRep & "\" & sNomFic, _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ OpenAfterPublish:=False Set OutApp = CreateObject("outlook.application") Set OutMail = OutApp.CreateItem(0) With OutMail .To = "XXXX@restofraisXXXX.fr" .Cc = "XXXX@restoXXXXX.fr" .Attachments.Add (sRep & "\" & sNomFic) .Subject = "verif achat" .Display End With With Application .ScreenUpdating = True .EnableEvents = True End With Kill (sRep & "\" & sNomFic) End Sub
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 Sub pdfOK() 'www.contextures.com 'for Excel 2010 and later Dim wsA As Worksheet Dim wbA As Workbook Dim strTime As String Dim strName As String Dim strPath As String Dim strFile As String Dim strPathFile As String Dim myFile As Variant Set wbA = ActiveWorkbook Set wsA = ActiveSheet strTime = Format(Now(), "yyyymmdd\_hhmm") 'obtenir le dossier du classeur actif, si sauvegardé strPath = wbA.Path If strPath = "" Then strPath = Application.DefaultFilePath End If strPath = strPath & "\" 'remplacer les espaces et les points dans le nom de la feuille strName = Replace(wsA.Name, " ", "") strName = Replace(strName, ".", "_") 'créer un nom par défaut pour le fichier de sauvegarde strFile = Range("I6") & Range("I7") & Range("I8") & ".pdf" strPathFile = strPath & strFile 'l'utilisation peut entrer le nom et 'sélectionnez le dossier pour le fichier myFile = Application.GetSaveAsFilename _ (InitialFileName:=strPathFile, _ FileFilter:="PDF Files (*.pdf), *.pdf", _ Title:="Select Folder and FileName to save") 'export to PDF if a folder was selected If myFile <> "False" Then Dim Ar(4) As String ' a dimensionner fonction du nombre de feuille Ar(0) = "SOMMAIRE" Ar(1) = "suivi achat" 'Ar(0) a Ar(x) doit contenir le nom des onglets a selectionner Ar(2) = "main courante" Ar(3) = "Etat des Salaire" Ar(4) = "Synthèse Mercu" Application.ScreenUpdating = False Sheets(Ar).Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myFile _ , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=False 'confirmation message with file info MsgBox "PDF file has been created: " _ & vbCrLf _ & myFile End If Application.ScreenUpdating = True Exit Sub errHandler: MsgBox "Could not create PDF file" Application.ScreenUpdating = True End Sub
Partager