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
| Dim MaBD As Database
Dim MaRequete As Recordset
'Dim Myrange As Range
Dim NbEnreg, i As Integer
Dim MonTableau As Object
Dim vnt As Variant
Dim j As Integer
'Vérifie si un élément est choisi dans la liste
If Me.choix_parcelle.ItemsSelected.Count = 0 Then
MsgBox "Vous n'avez pas sélectionné de parcelle !", vbCritical, "Opération annulée !"
Else
'confirmer l'impression
answer = MsgBox("Etes-vous sûr de vouloir exporter la sélection dans Word ?", vbYesNo + vbQuestion, "Confirmer export")
'MsgBox "Etes-vous sûr de vouloir imprimer un courrier pour la sélection ?", vbYesNo + vbQuestion, "Confirmer impression"
If answer = vbYes Then
'Compte le nombre d'enregistrements dans la requête R_proprietaire_publipostage
'et arrête la procédure de transfert
'si la requête ne contient aucun enregistrement
'Création d'une instance de Word et activation de l'application.
Set MonAppliWord = New Word.Application
'Création de la variable objet Lettre_type représentant
'le document Word
Set Lettre_type = MonAppliWord.Documents.Add("C:\BD_travaux_SMBA\Lettre_type.dotx")
MonAppliWord.Visible = True
For Each vnt In Me.choix_parcelle.ItemsSelected
For j = 0 To Me.choix_parcelle.ColumnCount - 6
NbEnreg = DCount("[num_parcelle]", "R_proprietaire_publipostage", "id_parcelle like " & Me.choix_parcelle.Column(j + 1, vnt))
'If NbEnreg = 0 Then
'MsgBox "Aucune parcelle n'a été liée à ce propriétaire !", vbCritical, "Opération annulée !"
'Exit Sub
'End If
'Ouvre la base de données en cours et la requête concernée
Set MaBD = CurrentDb()
Set MaRequete = MaBD.OpenRecordset("SELECT * FROM R_proprietaire_publipostage WHERE id_parcelle like " & "" & Me.choix_parcelle.Column(j + 1, vnt) & "", dbOpenSnapshot)
'Positionnement sur le premier enregistrement de la requête
MaRequete.MoveFirst
'Insertion des coordonnées du client
On Error Resume Next
With Lettre_type.Bookmarks
.Item("societe").Range.Text = MaRequete.Fields("societe")
.Item("civilité").Range.Text = MaRequete.Fields("civilité")
.Item("civilite1").Range.Text = MaRequete.Fields("civilite1")
.Item("civilite2").Range.Text = MaRequete.Fields("civilite2")
.Item("nom_jeune_fille").Range.Text = MaRequete.Fields("nom_jeune_fille")
.Item("nom_usage").Range.Text = MaRequete.Fields("nom_usage")
.Item("prenom").Range.Text = MaRequete.Fields("prenom")
.Item("adresse1").Range.Text = MaRequete.Fields("adresse1")
.Item("adresse2").Range.Text = MaRequete.Fields("adresse2")
.Item("code_postal").Range.Text = MaRequete.Fields("code_postal")
.Item("commune").Range.Text = MaRequete.Fields("commune")
.Item("pays").Range.Text = MaRequete.Fields("pays")
End With
'Création du tableau Word
'recevant les parcelles des propriétaires
Set MonTableau = Lettre_type.Tables.Add(Lettre_type.Bookmarks.Item("Debut_parcelle").Range, NbEnreg + 1, 3)
'Remplissage de la ligne d'en-tête du tableau
With MonTableau
.Cell(1, 1).Range.InsertAfter "Commune"
.Cell(1, 2).Range.InsertAfter "Section"
.Cell(1, 3).Range.InsertAfter "Numéro"
'Mise en forme du tableau
.Rows(1).SetHeight RowHeight:=24, HeightRule:=wdRowHeightAtLeast
.Rows(1).Cells.VerticalAlignment = wdAlignVerticalCenter
.Rows(1).Cells.HorizontalAlignment = wdAlignHorizontalCenter
'Ajustement des largeurs de colonnes aux dimensions souhaitées
.Columns(1).SetWidth ColumnWidth:=170, RulerStyle:=wdAdjustProportional
.Columns(2).SetWidth ColumnWidth:=60, RulerStyle:=wdAdjustProportional
.Columns(3).SetWidth ColumnWidth:=60, RulerStyle:=wdAdjustProportional
End With
'Remplissage du tableau avec les données
'issues de la requête R_proprietaire_publipostage
For i = 1 To NbEnreg
'Parcourt la requête R_proprietaire_publipostage,
'ajoute les contenus dans les cellules
With MonTableau
.Cell(i + 1, 1).Range.InsertAfter MaRequete!nom_commune
.Cell(i + 1, 2).Range.InsertAfter MaRequete!section
.Cell(i + 1, 3).Range.InsertAfter MaRequete!num_parcelle
'Puis Centrage vertical des contenus de cellules de toute la ligne
.Rows(i + 1).Cells.VerticalAlignment = wdCellAlignVerticalCenter
'Alignement de la référence et de la quantité au centre de la cellule
.Cell(i + 1, 2).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(i + 1, 3).Range.Paragraphs.Alignment = wdAlignParagraphCenter
End With
'Se positionne sur l'enregistrement suivant
MaRequete.MoveNext
Next i
With Lettre_type.Tables(1)
With .Borders(wdBorderLeft)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth150pt
End With
With .Borders(wdBorderRight)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth150pt
End With
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth150pt
End With
With .Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth150pt
End With
With .Borders(wdBorderHorizontal)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth075pt
End With
With .Borders(wdBorderVertical)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth075pt
End With
End With
Next j
MaRequete.Close
MaBD.Close
MonAppliWord.Close
Next vnt
Set MonAppliWord = Nothing
End If
End If |
Partager