Discussion :

[benadry]

Bonjour,

Je me permets de vous solliciter pour des difficultés d'exécution de macro qui permettent d'éditer des courriers sous Word à partir d'une base de données Excel.

N'ayant que très peu de compétences en VBA, j'avais demandé de l'aide sur un autre forum et j'avais obtenu une réponse en apparence très satisfaisante.

Le problème est que les macros ne fonctionnent pas corrrectement : tantôt elles marchent, deux minutes après plus rien !

J'ai des problèmes d'erreur 400, erreur 1104 (même quand les courriers Word sont dans le bon répertoire : ici, pour envoyer les courriers en pièces jointes, j'ai modifié le chemin).

Je suppose qu'il doit y avoir juste un petit problème, mais je n'y comprends rien !!!

Le but de ces macros est d'éditer des courriers automatiquement quand tous les champs obligatoires sont remplis. Une macro vérifie que les champs sont remplis, puis, dans l'affirmative, lance le courrier correspondant.
Par ailleurs, sur le n° d'identifiant et la clé, la macro demande à l'utilisateur de conformer sa saisie.

Dernier problème : le fichier Excel doit être alimenté à partir d'une ancienne base de données. Bien sûr, les courriers ne seront édités que pour l'avenir. Peut-être le problème est-il venu de cette transposition ?

Je vous remercie vivement d'avance pour votre aide.

Cordialement.

[Invité]

Bonjour,

Ci-joint une solution.

Le code présent dans le module standard : Module_VerificationEtEdition

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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
 
 
Option Explicit
 
'http://www.developpez.net/forums/d1351597/logiciels/microsoft-office/excel/problemes-macro-edition-courrier-excel-word/
 
' Macro modifiée par Eric KERGRESSE EIRL le 16/06/2013
 
'Public Const CheminFichiersWord As String = "C:\Users\Eric\Documents\VBA Excel\Développez-Com\Word\Mailing\"
Public Const CheminFichiersWord As String = "G:\"
Public Const LigneDeTitre As Long = 3
 
 
Public Ligne As Long
Public I As Long
Public Reponse As Long
 
Public ColDateEtablissement As Long
Public ColType As Long
Public ColLocalisation As Long
Public ColAdresse As Long
Public ColCodePostal As Long
Public ColVille As Long
Public ColNom As Long
Public ColPrenom As Long
 
Public ColIdentificationSansCle As Long
Public ColCleIdentifiantAss As Long
Public ColCleIdentifiantPs As Long
 
Public ColTypeOpposition As Long
Public ColEtape As Long
Public ColReferenceTraitement As Long
Public ColTraitementPar As Long
Public ColTraitementNom As Long
 
 
Public ColImpression As Long
 
 
Public ShDonnees As Worksheet
Public Continuer As Boolean
 
Public wApp As Object
Public oDoc As Object
 
Public Completude As String
Public MessagePresenceColonnes As String
 
'Vérification de la complétude des informations et message d'erreur
Sub Verification_Completude()
 
Dim MatriceControleColonnes() As Long
 
 
    ' Inventaire des colonnes à vérifier
    MatriceControleColonnes = Array(ColDateEtablissement, ColType, ColLocalisation, ColAdresse, ColCodePostal, ColVille, _
        ColNom, ColPrenom, ColIdentificationSansCle, ColCleIdentifiantAss, ColCleIdentifiantPs, _
        ColTypeOpposition, ColEtape, ColReferenceTraitement, ColTraitementPar, ColTraitementNom)
 
    Completude = "Attention ! Vous n'avez pas rempli les colonnes suivantes : "
 
    For I = LBound(MatriceControleColonnes, 1) To UBound(MatriceControleColonnes, 1)
        'Si pas de valeur alors on inscrit la colonne dans une variable appelée Completude
        If ShDonnees.Cells(Ligne, MatriceControleColonnes(I)) = "" Then Completude = Completude & vbLf & "-" & MatriceControleColonnes(I) & " : " & ShDonnees.Cells(LigneDeTitre, MatriceControleColonnes(I)) & ","
    Next I
 
    If Completude <> "Attention ! Vous n'avez pas rempli les colonnes suivantes : " Then Continuer = False
 
End Sub
 
 
Sub LancerLEdition()
 
            Reponse = MsgBox("Vous allez imprimer le courrier. Voulez-vous continuer ?", vbOKCancel + vbQuestion)
            If Reponse = vbOK Then
 
                Set wApp = CreateObject("Word.Application")
                wApp.Visible = True
 
                Select Case ShDonnees.Range("T4")
                    Case "Refus"
                         Set oDoc = wApp.Documents.Add(CheminFichiersWord & "Opposition_refus.doc")
                         EditionDocument "Opposition_refus"
 
                    Case "Opposition_non_prio"
                         Set oDoc = wApp.Documents.Add(CheminFichiersWord & "Opposition_non_prio.doc")
                         EditionDocument "Opposition_non_prio"
 
                    Case "Opposition_PEC"
                         Set oDoc = wApp.Documents.Add(CheminFichiersWord & "Opposition_acceptation.doc")
                         EditionDocument "Opposition_acceptation"
 
                    Case "Cession des rémunérations"
                         Set oDoc = wApp.Documents.Add(CheminFichiersWord & "Opposition_salaires.doc")
                         EditionDocument "Cession_remunerations"
                End Select
 
                oDoc.PrintOut
                oDoc.Close SaveChanges:=wdDoNotSaveChanges
 
                 wApp.Quit ' Fermeture de Word
 
                 Set oDoc = Nothing
                 Set wApp = Nothing
 
            End If
 
 
End Sub
 
 
Sub EditionDocument(NomDuDocument As String)
 
        'Affectation des données Excel aux signets
        oDoc.Bookmarks("Type_créancier").Range.Text = ShDonnees.Range("C" & Ligne)
        oDoc.Bookmarks("Localisation").Range.Text = ShDonnees.Range("D" & Ligne)
        oDoc.Bookmarks("Adresse").Range.Text = ShDonnees.Range("E" & Ligne)
        oDoc.Bookmarks("Complément").Range.Text = ShDonnees.Range("F" & Ligne)
        oDoc.Bookmarks("CP").Range.Text = ShDonnees.Range("G" & Ligne)
        oDoc.Bookmarks("Ville").Range.Text = ShDonnees.Range("H" & Ligne)
        oDoc.Bookmarks("Traité_par").Range.Text = ShDonnees.Range("AB" & Ligne)
        oDoc.Bookmarks("Type_oppo").Range.Text = ShDonnees.Range("R" & Ligne)
        oDoc.Bookmarks("Prénom").Range.Text = ShDonnees.Range("L" & Ligne)
        oDoc.Bookmarks("Nom").Range.Text = ShDonnees.Range("K" & Ligne)
        oDoc.Bookmarks("Date_étab").Range.Text = ShDonnees.Range("A" & Ligne)
        oDoc.Bookmarks("Interv").Range.Text = ShDonnees.Range("AC" & Ligne)
        oDoc.Bookmarks("Ref").Range.Text = ShDonnees.Range("AA" & Ligne)
        oDoc.Bookmarks("Complément2").Range.Text = ShDonnees.Range("I" & Ligne)
 
        If NomDuDocument = "Opposition_refus" Then oDoc.Bookmarks("Motif_refus").Range.Text = ShDonnees.Range("U" & Ligne) ' Opposition_Refus
        If NomDuDocument = "Cession_remunerations" Then oDoc.Bookmarks("Ref_cré").Range.Text = ShDonnees.Range("J" & Ligne) ' Cession_Remunerations
 
End Sub
 
 
 
 
Function RechercherColonne(FeuilleRecherche As Worksheet, LigneTitre As Long, TitreRecherche As String)
 
 Dim NbColonnes As Long
 Dim CelluleEnCours As Range
 
    RechercherColonne = 0
 
    With FeuilleRecherche
    NbColonnes = .Cells(LigneTitre, FeuilleRecherche.Columns.Count).End(xlToLeft).Column
 
  '  ActiveSheet.Range(Cells(LigneTitre, 1), Cells(LigneTitre, NbColonnesAchat)).Select
 
    For Each CelluleEnCours In .Range(.Cells(LigneTitre, 1), .Cells(LigneTitre, NbColonnes))
        Select Case Mid(CelluleEnCours, 1, Len(TitreRecherche))
               Case TitreRecherche
                    RechercherColonne = CelluleEnCours.Column
                    Exit For
        End Select
    Next
 
    End With
 
    If RechercherColonne = 0 Then
        MessagePresenceColonnes = MessagePresenceColonnes & Chr(10) & TitreRecherche
    End If
 
 
End Function
 
Sub ControlerLaPresenceDesColonnes(FeuilleTitre As Worksheet)
 
        MessagePresenceColonnes = "Absence colonnes :"
 
        ColDateEtablissement = RechercherColonne(FeuilleTitre, LigneDeTitre, "Date d'établissement")
        ColType = RechercherColonne(FeuilleTitre, LigneDeTitre, "Type")
        ColLocalisation = RechercherColonne(FeuilleTitre, LigneDeTitre, "Localisation")
        ColAdresse = RechercherColonne(FeuilleTitre, LigneDeTitre, "Adresse")
        ColCodePostal = RechercherColonne(FeuilleTitre, LigneDeTitre, "Code postal")
        ColVille = RechercherColonne(FeuilleTitre, LigneDeTitre, "Ville")
        ColNom = RechercherColonne(FeuilleTitre, LigneDeTitre, "Nom")
        ColPrenom = RechercherColonne(FeuilleTitre, LigneDeTitre, "Prénom")
        ColIdentificationSansCle = RechercherColonne(FeuilleTitre, LigneDeTitre, "N° d'identification")
        ColCleIdentifiantAss = RechercherColonne(FeuilleTitre, LigneDeTitre, "Clé ASS")
        ColCleIdentifiantPs = RechercherColonne(FeuilleTitre, LigneDeTitre, "Clé PS")
 
        ColTypeOpposition = RechercherColonne(FeuilleTitre, LigneDeTitre, "Type d'opposition")
        ColEtape = RechercherColonne(FeuilleTitre, LigneDeTitre, "Etape")
        ColReferenceTraitement = RechercherColonne(FeuilleTitre, LigneDeTitre, "Référence traitement informatique")
        ColTraitementPar = RechercherColonne(FeuilleTitre, LigneDeTitre, "Traitement par")
        ColTraitementNom = RechercherColonne(FeuilleTitre, LigneDeTitre, "Traitement Nom")
 
        If MessagePresenceColonnes <> "Absence colonnes :" Then
           Continuer = False
           MsgBox (MessagePresenceColonnes)
        End If
 
End Sub

Le code présent dans le module de l'onglet "Feuil1" :

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
69
70
71
72
73
74
75
76
77
78
79
80
81
 
 
Option Explicit
 
' Macro modifiée par Eric KERGRESSE EIRL le 16/06/2013
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
 
    ' Les données commencent à la ligne 4
    If Target.Count > 1 Then Exit Sub
    If Target.Row <= LigneDeTitre Then Exit Sub
 
    Set ShDonnees = ActiveSheet
 
 
   On Error Resume Next
   If Not Application.Intersect(Target, ShDonnees.Columns("D:D")) Is Nothing Then
      Target = StrConv(Target, 1) ' Mise en majuscule de la localisation
      Exit Sub
   End If
 
 
   On Error Resume Next
   If Not Application.Intersect(Target, ShDonnees.Columns("K:K")) Is Nothing Then
      Target = StrConv(Target, 1) ' Mise en majuscule du nom
      Exit Sub
   End If
 
   On Error Resume Next
   If Not Application.Intersect(Target, ShDonnees.Columns("L:L")) Is Nothing Then
      Target = StrConv(Target, 3) ' Convertit la première lettre de chaque mot de la chaîne en majuscule
      Exit Sub
   End If
 
 
   ' La colonne AG est la colonne Impression. Un Oui saisi dans la cellule déclenche l'ordre d'impression.
   On Error Resume Next
   If Not Application.Intersect(Target, ShDonnees.Columns("AG:AG")) Is Nothing Then
 
            Ligne = Target.Row
 
            Continuer = True
            ControlerLaPresenceDesColonnes ShDonnees
            If Continuer = False Then
                    MsgBox (MessagePresenceColonnes)
                    Exit Sub
            End If
 
            Continuer = True
            Verification_Completude
 
            Select Case UCase(Target)
            Case Is = "OUI"
                    If Continuer = True Then
 
                                Reponse = MsgBox("Vous avez saisi le n° d'identifiant suivant" & vbLf & Cells(Ligne, ColIdentificationSansCle) & _
                                    "." & vbLf & "Cela a généré la clé" & vbLf & Cells(Ligne, ColCleIdentifiantAss) & "." & _
                                    vbLf & "Confirmez-vous ces informations ?", vbOKCancel + vbQuestion)
 
                                Select Case Reponse
                                       Case vbOK
                                            If Cells(Target.Row, ColImpression) <> "" Then LancerLEdition
                                       Case vbCancel
                                         Cells(Target.Row, ColIdentificationSansCle).ClearContents
                                End Select
                     Else
                                If Completude <> "Attention ! Vous n'avez pas rempli les colonnes suivantes : " Then
                                            MsgBox (Completude & vbLf & vbLf & "Fin de programme !")
                                            Exit Sub
                                End If
                     End If
 
             End Select
             Exit Sub
 
    End If
 
    Set ShDonnees = Nothing
 
End Sub

L'impression ne se déclenche que si "Oui" est saisi dans la colonne AG.

Il faut traiter les événements Change de la feuille avec la méthode Application.Intersect :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
   On Error Resume Next
   If Not Application.Intersect(Target, ShDonnees.Columns("D:D")) Is Nothing Then
      Target = StrConv(Target, 1) ' Mise en majuscule de la localisation
      Exit Sub
   End If

Ce qui évitera à vos collaborateurs de balancer leur micro à travers l'Open Space tant les validations des cellules sont irritantes.
Je n'ai dû effacer les validations que sur la ligne 4....

Avec cette méthode, vous pouvez contrôler toute la saisie d'une façon transparente pour les utilisateurs.

A chaque Application.Intersect, une commande Exit Sub permet d'interrompre la procédure pour ne pas enclencher la séquence suivante.

Chez moi, le mailing fonctionne correctement avec tous les documents.

Attention si vous changez le nom des colonnes, car il faut garantir des libellés sans homonymie. J'ai modifié des libellés pour le bon fonctionnement. Le cas échéant, il vous faudra modifier les libellés dans la procédure ControlerLaPresenceDesColonnes dans le module standard.

Je me suis peut-être emmêlé les pinceaux dans la cellule Référence à prendre en compte. A vous de vérifier et de changer le cas échéant.

Dernier conseil : Rien ne vous interdit d'avoir des noms de variable avec des libellés totalement explicites.

Bon courage pour la suite, je ne voudrais pas être à la place de la famille Panou Panou....


Cordialement.

[benadry]

Bonjour,

Un très grand merci à Monsieur Kergresse.

Je teste tout de suite votre solution et je reviens vers vous pour vous dire si tout fonctionne.

Merci encore.

Bien cordialement.

Benadry.

[benadry]

Rebonjour,

De nouveau un très grand merci à vous Monsieur Kergresse.

La base est, effectivement, beaucoup plus simple d'utilisation.

J'ai juste deux petits problèmes :
- la vérification de complétude ne s'effectue pas ;
- bien que le code des lignes 99 à 102 me semble correct (mais, je suis loin d'être un spécialiste), la macro ouvre Word et le courrier est généré, mais il n'y a pas d'impression automatique, ni de fermeture de Word sans enregistrement.

Par ailleurs, je me suis rendu compte que les codes postaux inférieurs à 10000 étaient tronqués dans le courrier Word. Exemple : Charleville-Mézières sort à 8000. Pourtant, il est bien en format code postal dans la base. J'avais déjà lu quelque chose là-dessus. Je pense qu'il faut paramétrer, dans la macro, le format code postal, mais je ne sais pas comment faire.

Encore un grand merci.

A vous relire.

Benadry

[Invité]

Bonjour,

Ci-joint, une nouvelle version.

Attention :

• Au chemin des courriers défini en constante dans le module standard.
• Au nom des colonnes si vous les modifiez.

M'indiquer lorsque vous testez, si vous le faites sur ma version ou sur une version à vous dans laquelle vous avez retranscrit le code.

Cordialement.

[benadry]

Bonsoir,

Désolé de ne pas vous avoir répondu plus tôt : je viens de prendre connaissance de votre message.

Je teste votre dernier fichier ce soir et je reviens vers vous demain matin pour vous dire si tout fonctionne.

Merci encore pour votre compétence, votre réactivité et votre gentillesse.

Cordialement.

Benadry