generer des tableaux depuis un liste

Version imprimable

16/01/2014, 11h59
ajmi6895

generer des tableaux depuis un liste

bonjour,
J'ai une liste de noms dans un tableau excel A. J'ai aussi un tableau original B.
J'aimerais ecrire une macro qui listerait les noms de mon tableau A, et pour chacune des lignes, j'aimerais que la macro ouvre le tableau original B, remplisse certains champs et enregistre une copie du fichier, puis envoie ce fichier par e-mail à l'adresse de chacune des personnes du tableau A.
Quelqu'un peut-il m'aider ?
je débute avec les macro excel
merci
cordialement
jean-pierre
16/01/2014, 17h26
parmi

Bonjour,

On voudrait bien aider mais ça manque de détails...
Peux-tu mettre une image de ta/tes feuilles ou joindre un fichier avec des données non confidentielles mais qui représente ton fichier ?

On ne sait pas quelles données tu veux copier et où tu veux les coller... (?)
17/01/2014, 09h34
ajmi6895

1 pièce(s) jointe(s)

bonjour, merci de tenter de m'aider
ci-joints le fichier liste, le fichier modele a remplir, et un exemple de ce à quoi je voudrais arriver
je voudrais que la macro lise cette liste (il y aura de 60 a 80 noms sur cette liste) et pour chaque ligne, extrait le nom, le prenom, le groupe, le plafond pour remplir le tableau fichier modele puis enregistre le fichier avec le nom (colonne d du tableau liste) et envoie ce fichier a l'adresse mail colonne F
merci
cordialement
jp
17/01/2014, 16h34
defluc

Hello,

Il faudrait que tu précises certaines choses.
Dans quel classeur se trouvera la macro et qu'est-ce qui la déclenchera ?
17/01/2014, 17h08
ajmi6895

bonjour,
je pensais mettre la macro dans le fichier liste
et la declencher manuellement
merci de m'aider, j'essaie de chercher avec des boucles while mais j'avoue que je debute vraiment (je me servirai de ce que tu pourras m'ecrire pour essayer de comprendre et reproduire)
cordialement
jp

Salut à toi,

Après réflexion, je sauvegarderais le fichier modèle en tant que modèle Excel.

Puis je placerais le code suivant dans un module.

Code:

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
Option Explicit
Sub MaMacro()
Dim OutWbk As Workbook
Dim OutSh As Worksheet, ListSh As Worksheet
Dim Path As String, FileOutName As String
Dim LineNo As Long
Dim Mail As Object
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Path = ThisWorkbook.Path & "\"
  Set ListSh = ThisWorkbook.Sheets("Feuil1")
  Set Mail = CreateObject("CDO.Message")
  LineNo = 2
  While ListSh.Cells(LineNo, 1) <> ""
    Set OutWbk = Workbooks.Open(Path & "fichier modele.xls")
    Set OutSh = OutWbk.Sheets("Collection été")
    OutSh.Cells(5, 2) = ListSh.Cells(LineNo, 1).Value  '  Copie du prénom
    OutSh.Cells(5, 4) = ListSh.Cells(LineNo, 2).Value  '  Copie du nom
    OutSh.Cells(5, 6) = ListSh.Cells(LineNo, 5).Value  '  Copie du groupe
    FileOutName = Path & ListSh.Cells(LineNo, 4).Value
    OutWbk.SaveAs (FileOutName)  '  sauvegarde du classeur nominatif
    OutWbk.Close False
    With Mail  '  envoi du classeur par mail
        .Subject = "Catalogue Collection été"
        .From = "moi@mail.com"
        .To = ListSh.Cells(LineNo, 6).Value
        .TextBody = "Veuillez trouver en pièce jointe notre nouvelle collection"
        .AddAttachment FileOutName
        .Send
    End With
    LineNo = LineNo + 1
  Wend
  Set OutWbk = Nothing
  Set OutSh = Nothing
  Set ListSh = Nothing
  Set Mail = Nothing
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

Il ne reste plus qu'à tester.

20/01/2014, 10h31
ajmi6895

bonjour defluc et un grand merci pour ton aide

j'ai collé ton script dans le fichier liste, tout à l'air de fonctionner à merveille (le fichier est bien créé, il porte le bon nom, les champs sont bien remplis) sauf l'envoi du mail qui me retourne le message d'erreur :

Citation:

Erreur d'exécution '-2147220960 (80040220)':
"la valeur de configuration "SendUsing" est non valide"

j'ai testé en remplacant : .From = "moi@mail.com" par
.From = "mon adresse réelle valide"
et j'ai mis la même adresse dans la liste et supprimé toutes les adresses bidons
j'ai toujours le même message d'erreur

puis-je encore solliciter ton aide ?

merci
cordialement
jp

Probablement une erreur due au fait que ton serveur de mails n'utilise pas les paramètres par défaut.
J'ai donc complété le code par la configuration du serveur

Code:

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
Sub MaMacro()
Dim OutWbk As Workbook
Dim OutSh As Worksheet, ListSh As Worksheet
Dim Path As String, FileOutName As String
Dim LineNo As Long
Dim Mail As Object, SendConfig As Object
Dim Flds As Variant
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Path = ThisWorkbook.Path & "\"
  Set ListSh = ThisWorkbook.Sheets("Feuil1")
  Set Mail = CreateObject("CDO.Message")
  Set SendConfig = CreateObject("CDO.Configuration")
  Set Flds = SendConfig.Fields
  With Flds
   .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
   .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.MonHebergeur.fr"
   .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
   .Update
  End With
  LineNo = 2
  While ListSh.Cells(LineNo, 1) <> ""
    Set OutWbk = Workbooks.Open(Path & "fichier modele.xls")
    Set OutSh = OutWbk.Sheets("Collection été")
    OutSh.Cells(5, 2) = ListSh.Cells(LineNo, 1).Value  '  Copie du prénom
    OutSh.Cells(5, 4) = ListSh.Cells(LineNo, 2).Value  '  Copie du nom
    OutSh.Cells(5, 6) = ListSh.Cells(LineNo, 5).Value  '  Copie du groupe
    FileOutName = Path & ListSh.Cells(LineNo, 4).Value
    OutWbk.SaveAs (FileOutName)  '  sauvegarde du classeur nominatif
    OutWbk.Close False
    With Mail  '  envoi du classeur par mail
      Set .Configuration = SendConfig
      .Subject = "Catalogue Collection été"
      .From = "moi@mail.com"
      .To = ListSh.Cells(LineNo, 6).Value
      .TextBody = "Veuillez trouver en pièce jointe notre nouvelle collection"
      .AddAttachment FileOutName
      .Send
    End With
    LineNo = LineNo + 1
  Wend
  Set OutWbk = Nothing
  Set OutSh = Nothing
  Set ListSh = Nothing
  Set Mail = Nothing
  Set SendConfig = Nothing
  Set Flds = Nothing
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

Le serveur sortant et le port de sortie doivent bien sûr être adapté à ton cas dans les lignes

Code:

1
2
   .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.MonHebergeur.fr"
   .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

20/01/2014, 16h17
ajmi6895

bonjour
je pense que tu as raison, il s'agit d'un problème de parametrage du compte de messagerie
il s'agit d'un protocole exchange, j'ai bien trouvé l'adresse du serveur de courrier sortant, mais le message d'erreur ne change pas
je ne sais pas si il faut mettre des parametres pour un tunnel ssl, ni quel est le port
j'ai demandé du soutien en interne dans ma société
je te remercie de tout le mal que tu t'es donné pour m'aider
cordialement
jp
20/01/2014, 17h20
defluc

Je te conseille d'ouvrir un nouveau topic limité à ce problème en marquant celui-ci comme résolu.