Discussion :

[KaiZ0kuu]

Bonjour à tous,

Je suis presque sur que cela existe déjà, mais je n'arrive pas trouver ce que je veux en cherchant par moi même (probablement pas les bons mots clefs )
Alors, ce que je veux faire n'a pas l'air très compliqué mais au vu de mes compétences limités, ca l'est déjà plus !

J'ai un excel avec plusieurs onglets, chacun correspondant à une personne différente. Je voudrais un code enregistrant chaque onglet dans un excel distinct, puis générer un mail par personne avec son onglet attitré en PJ.
Je voudrais également que soit pré rempli :
L'adresse mail. => A aller chercher dans une cellule.
Une personne en copie => => A aller chercher dans une cellule.
L'objet (identique pour tous) => A aller chercher dans une cellule.
Le corps du mail => A aller chercher dans une cellule.

Pour le moment, j'ai réussi à enregistrer chaque onglet dans un excel distinct puis... c'est tout après je patoge depuis des heures et n'arrive a rien.

Mon code actuel, très basique mais qui fonctionne pour enregistrer les onglets :

Code vba :

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
Sub CopieOnglets()
 
Dim onglet As Workbook
Set onglet = ActiveWorkbook
 
Dim nouveauFichier As Workbook
 
For Each fSheet In onglet.Worksheets
    Workbooks.Add
    Set nouveauFichier = ActiveWorkbook
    fSheet.Copy Before:=nouveauFichier.Sheets(1)
    nouveauFichier.SaveAs Filename:="Chemin" & "\" & fSheet.Name, FileFormat:=xlOpenXMLWorkbook
    nouveauFichier.Close False
Next
 
onglet.Activate
 
End Sub

Merci d'avance,

Cordialement,

[mfoxy]

Bonsoir,

Ce billet de MarcelG pourrait te mettre sur la route au niveau de la liste de diffusion.

https://www.developpez.net/forums/d2...ils-variables/

Pour l'envoi de classeur par mail, il suffira d'ajouter le chemin complet du fichier en lieu et place de l'attachement.

Bav

[Floyd-44]

Un petit Modèle à Adapter à ton cas mais qui marche pas mal

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
 
Set oOutlookApp = CreateObject("Outlook.Application")
Set oItem = oOutlookApp.CreateItem(olMailItem)
oItem.Subject = "Objet de ton email"
    oItem.Body = "Bonjour," & vbCrLf & vbCrLf & "Ci-joint les documents demandés." & vbCrLf 'Corps du mail
      oItem.Recipients.Add (Mail) 'Adresse stockée dans une variable
  ' On va chercher les pièces jointes mais à priori tu peux t'en passer en remplaçant la source par ton nom de fichier à joindre
    With Application.FileDialog(msoFileDialogOpen)
      .AllowMultiSelect = True 
      .Show
      For lngCount = 1 To .SelectedItems.Count
        oItem.Attachments.Add Source:=.SelectedItems(lngCount) 
      Next lngCount
    End With
    oItem.Display
'A ce stade il t'affiche le mail à l'écran pour contrôle avant envoi
'Tu peux ajouter un .Send pour envoi

[KaiZ0kuu]

Bon, j'ai mélangé un peu tout en + de ce que j'ai trouvé sur le net et cela fonctionne correctement.
Encore à perfectionner (ajout de la signature, corp du mail en html ect... mais c'est déjà moins chiant )

Si ça peut servir :

Générer les différents excel par onglet :

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
Sub CopieOnglets()
 
Dim onglet As Workbook
Dim nouveauFichier As Workbook
Set onglet = ActiveWorkbook
 
For Each fSheet In onglet.Worksheets
    Workbooks.Add
    Set nouveauFichier = ActiveWorkbook
    fSheet.Copy Before:=nouveauFichier.Sheets(1)
    nouveauFichier.SaveAs Filename:="\\altitudeinfra.fr\AI_Users\AnthonyS\07_Equipe NOC\Notes\Excel_Techs" & "\" & fSheet.Name, FileFormat:=xlOpenXMLWorkbook
    nouveauFichier.Close False
Next
onglet.Activate
 
End Sub

Générer les emails avec les excel en PJ :

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
Private OL_App As Object
Private OL_Mail As Object
Private sSubject As String, sBody As String
 
Sub SendDocuments()
 
Dim i As Long
Dim tabContactNames As Variant, tabContactEmails As Variant, tabFNames As Variant
Application.ScreenUpdating = False
 
' Ouverture d'outlook
On Error Resume Next
Set OL_App = GetObject(, "Outlook.Application")
If OL_App Is Nothing Then
Set OL_App = CreateObject("Outlook.Application")
End If
On Error GoTo 0
' Objet du mail + corps du mail
sSubject = Range("D3").Value
sBody = Range("B8").Value
' Lecture de la liste des contacts
tabContactNames = Range("C25:C34").Value
tabContactEmails = Range("B25:B34").Value
tabFNames = Range("E25:E34").Value
' Générer les emails
For i = 1 To UBound(tabContactNames, 1)
If tabContactNames(i, 1) <> vbNullString Then
Call CreateNewMessage(tabContactNames(i, 1), tabContactEmails(i, 1), tabFNames(i, 1))
End If
Next i
 
MsgBox "Mail générés"
 
Set OL_App = Nothing
Set OL_Mail = Nothing
Application.ScreenUpdating = True
 
End Sub
 
 
Private Sub CreateNewMessage(strContactName, strContactTo, strFName)
 
 
Set OL_Mail = OL_App.CreateItem(0)
With OL_Mail
 
 .To = strContactTo
 .CC = "exemple@domain.com"
 '.BCC = "exemple@domain.com"
 
 .Subject = sSubject
 .Body = sBody
 .BodyFormat = 2 'Format : 0=inder; 1=plain text; 2= HTML; 3=rich text
 .Importance = 2 'Importance : 0=low; 1=normal; 2= high
 .Sensitivity = 3 'Confidentiality : 0=normal; 1=personal; 2=private; 3=confidential
 .Attachments.Add (strFName)
 
' Display or send the message
 .Display
 '.Send
End With
 
Set OL_Mail = Nothing
End Sub