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 |
Partager