Bonjour,
Après des heures de recherches sur le net, je viens de trouver un fichier Excel composé de 3 onglets et d'un module dont le code est le suivant :
Aucune complication pour comprendre ce code, la macro fonctionne correctement mais mon souci est le suivant :
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 Option Explicit Sub envoi_Feuille() Dim olapp As Outlook.Application Dim malist, Count, Envoi, AdresseRépertoire As Variant On Error Resume Next '-------Contrôler dans Bisual Basic/Outils/Références/que Microsoft Outlook --,- Object Librairy est bien coché Dim adresse(1 To 10) '----------------------Création de la liste d'adresses mail contenus de la ligne 2 à 10 Set malist = Sheets("Feuil1").Range("A2:A10") Count = 1 For Each Envoi In malist If Len(Envoi) Then adresse(Count) = Envoi: Count = Count + 1 Next '----------------------Copie de la liste d'adresse dans une cellule vide exemple H1 [H1] = Array(adresse(1) & "; " & adresse(2) & "; " & _ adresse(3) & "; " & adresse(4) & "; " & adresse(5) & "; " & adresse(6), adresse(7), adresse(8), adresse(9), adresse(10)) '-------adresse du répertoire ou sera enregistré le fichier AdresseRépertoire = ActiveWorkbook.Path '---------------------copie de la feuille à envoyer Application.DisplayAlerts = False Sheets("Feuil2").Copy '---------------------Nom du fichier à envoyer ActiveWorkbook.SaveAs AdresseRépertoire & "\" & "Class.xls" ' ou adresse si le nom est dans une cellule Range("E2").Value & ".xls" ActiveWindow.Close '---------------------Envoi par mail Sheets("Feuil1").Select Range("H1").Select '---------------------contrôle la validité ou la présence d'adresse mail en H1 If [H1] Like "*@*" Then '---------------------Le mail est envoyé que si y a des adresses feuille 1 en H1 Do While Not IsEmpty(ActiveCell) Dim msg As MailItem Set olapp = New Outlook.Application Set msg = olapp.CreateItem(olMailItem) msg.To = Range("H1").Value 'Adresse de la cellule contenant la liste des adesses mails '--------------------Saisir le sujet de l'envoi msg.Subject = "Coucou c'est moi " ' ou saisir le sujet dans une cellule ex. Range("H2").Value '---------------------saisie du message msg.Body = "Bonjour" & Chr(13) & Chr(13) & "Veuillez trouver ci-joint" & Chr(13) & "copie du dossier" & Chr(13) & Chr(13) & "Cordialement" '---------------------ou saisir le message dans des cellules 'msg.Body = Range("E5").Value & Chr(13) & Chr(13) & Range("E8").Value & Chr(13) & Chr(13)& Range("E10").Value '---------------------ou saisir le message dans des cellules '---------------------Adresse de la pièce jointe msg.Attachments.Add Source:=AdresseRépertoire & "\" & "Class.xls" ' ou adresse si le nom est dans une cellule Range("E2").Value & ".xls" msg.Send '---------------------effacement de la liste d'envoi [H1].ClearContents Loop Else MsgBox "Aucune adresse valide sélectionnée" End If Application.ScreenUpdating = True End Sub
Lorsque je veux intégrer ces 3 feuilles ainsi que le code dans un autre fichier Excel (ma base de données composée de 15 feuilles renommées autrement que Feuil1, Feuil2, ...., Feuil15) çà bug dans le code.
Si je renomme également les 3 feuilles du présent classeur (fichier joint) et que je modifie également le nom des feuilles dans le code Vba, çà bug aussi.
Sinon La feuille 3 a-t-elle une importance primordiale vu qu'elle n'est pas utilisée dans le code ?
Quelqu'un aurait il une solution à me proposer pour résoudre ce bug ?
Cordialement.
Partager