IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Problèmes macro édition de courrier Excel-Word


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre confirmé
    Inscrit en
    Juin 2013
    Messages
    114
    Détails du profil
    Informations forums :
    Inscription : Juin 2013
    Messages : 114
    Par défaut Problèmes macro édition de courrier Excel-Word
    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.
    Fichiers attachés Fichiers attachés

  2. #2
    Invité
    Invité(e)
    Par défaut
    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.

  3. #3
    Membre confirmé
    Inscrit en
    Juin 2013
    Messages
    114
    Détails du profil
    Informations forums :
    Inscription : Juin 2013
    Messages : 114
    Par défaut
    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.

  4. #4
    Membre confirmé
    Inscrit en
    Juin 2013
    Messages
    114
    Détails du profil
    Informations forums :
    Inscription : Juin 2013
    Messages : 114
    Par défaut
    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

  5. #5
    Invité
    Invité(e)
    Par défaut
    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.

  6. #6
    Membre confirmé
    Inscrit en
    Juin 2013
    Messages
    114
    Détails du profil
    Informations forums :
    Inscription : Juin 2013
    Messages : 114
    Par défaut
    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

Discussions similaires

  1. [XL-2010] Problème avec signets Word dans une macro d'édition de courriers
    Par benadry dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 11/04/2014, 15h55
  2. [XL-2003] Problème de collage de tableau Excel dans Word
    Par zert84 dans le forum Macros et VBA Excel
    Réponses: 15
    Dernier message: 03/07/2009, 15h03
  3. MACRO: Inserer une ref excel dans word
    Par tropik34 dans le forum VBA Word
    Réponses: 5
    Dernier message: 06/06/2008, 19h42
  4. Probléme export et fusion excel word
    Par JPDU92 dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 22/10/2007, 02h46
  5. [VBA-E] Problème macro excel
    Par pontus21 dans le forum Macros et VBA Excel
    Réponses: 32
    Dernier message: 19/05/2006, 18h38

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo