remplir le pied de page par VBA

Version imprimable

Bonjour,
Cette petite macro me fait tourner en rond !
J'ai trouvé la syntaxe sur un forum et ai juste modifié les cellules qui permettent de définir les variables texteleft, *center et *right.
Dans mes cellule A45, 46 et 47, il y une formule RECHERCHEV dont le résultat est du texte (adresse, N° siret et Téléphone).
Le msgbox me confirme que les valeurs affectées aux 3 variables Texte* sont bien ce que je cherche à intégrer dans mon pied de page.
Mais....la macro ne me remplit que le centre du pied, rien à droite et rien à gauche.
Et encore, le centre est remplit avec la variable de la dernière ligne. Ici texteleft. J'ai essayé de changer l'ordre des 3 lignes (13, 14 et 15), systématiquement, il me colle la variable de la ligne 15 au centre et rien à gauche et à droite.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Dim Police As String Dim Taille As String Dim TexteLeft As String Dim TexteCenter As String Dim TexteRight As String Police = "Arial" Taille = 6 TexteLeft = Range("A45").Value TexteCenter = Range("A47").Value TexteRight = Range("A46").Value MsgBox (TexteLeft & " " & TexteCenter & " " & TexteRight) ActiveSheet.PageSetup.RightFooter = "&""" & Police & ",normal""" & "&" & Taille & TexteRight ActiveSheet.PageSetup.CenterFooter = "&""" & Police & ",normal""" & "&" & Taille & TexteCenter ActiveSheet.PageSetup.LeftFooter = "&""" & Police & ",normal""" & "&" & Taille & TexteLeft
Quelqu'un aurai la clé du mystère?
Cordialement
Benoit

28/01/2020, 09h37
HopPopPop

Bonjour à tous,

J'ai procédé à un copier-coller de ton code dans une procédure public dans un module ... et tout est ok.
L'affichage avant impression montre le pied de page comme désiré, de même qu'on retrouve ces infos si on va dans la commande mise page.
28/01/2020, 09h50
Menhir

Idem pour moi : les éléments se placent correctement dans les trois parties du pied de page.
Le problème vient donc sans doute d'un élément extérieur à ce code.

Bonjour à tous, merci pour vos réponses.
Je deviens chèvre...
Ci dessous le code complet.
Je ne vois pas ce qui pourrais influencer, je n'y parle pas de pied de page. Mais vous aurez un oeil plus acéré que le mien.

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
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
Sub crea_offre()
 
'inhibe ouverture des onglets, pour éviter le clignotement quand on passe d'un onglet à l'autre
Application.ScreenUpdating = False
 
If Range("r12").Value <> 0 Then
    If MsgBox("La somme des PV retenus est différente des PV arrondis.", vbYesNo, "Confirmation") = vbNo Then
    Exit Sub
    End If
End If
 
If Range("t12").Value = 1 Then
Else
MsgBox ("Le total des conditions de paiement est différent de 100%")
Exit Sub
End If
 
                    '************
                    'RAZ des zones offres
                    '************
 
'définir les N° des lignes repère
 
Dim pB As Integer, pE As Integer
 
 
Sheets("Offre client").Activate
Range("A18").Select
While ActiveCell.Value <> "B"
    Selection.Offset(1, 0).Activate
Wend
pB = ActiveCell.Row
 
'MsgBox ("18 " & pB)
 
'RAZ zone machine
If pB - 18 > 2 Then         'si il y a plus d'une ligne de machine, on supprime celles en trop
    Rows("20:" & pB - 1).Select
    Selection.Delete shift:=x1Up
End If
 
Range("B19:E19,e20").Select 'on raz la ligne restante
Selection.ClearContents
 
'RAZ zone option
Range("A28").Select
While ActiveCell.Value <> "E"
    Selection.Offset(1, 0).Activate
Wend
pE = ActiveCell.Row
 
'MsgBox ("30 " & pE)
If pE - 30 > 2 Then     'si il y a plus d'une ligne d'option, on supprime celles en trop
    Rows("32:" & pE - 1).Select
    Selection.Delete shift:=x1Up
End If
 
Range("B31:E31").Select 'on raz la ligne restante
Selection.ClearContents
 
Range("a24").Select
'MsgBox ("RAZ faite")
 
 
                    '**************
                    'création des lignes de machines
                    '**************
Dim ligneoffre As Integer, ligneselect As Integer
ligneoffre = 19
ligneselect = 13
 
'trier par N° de machine croissant
Sheets("Selection").Activate
activeworkbook.Worksheets("Selection").AutoFilter.Sort.SortFields.Clear
    activeworkbook.Worksheets("Selection").AutoFilter.Sort.SortFields.Add Key:= _
        Range("e12"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With activeworkbook.Worksheets("Selection").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
Range("E13").Select
While ActiveCell.Value <> "" 'tant qu'il y a une machine sélectionnée
                'on copie les valeurs
            Sheets("Offre client").Activate
            Rows(ligneoffre).Select
            Selection.Copy
            Rows(ligneoffre + 1).Select
            Selection.Insert shift:=xlDown
 
                Worksheets("Offre client").Cells(ligneoffre, "b") = Worksheets("Selection").Cells(ligneselect, "e") 'ajouter M
                Worksheets("Offre client").Cells(ligneoffre, "c") = Worksheets("Selection").Cells(ligneselect, "g")
                Worksheets("Offre client").Cells(ligneoffre, "e") = Worksheets("Selection").Cells(ligneselect, "n")
 
          ligneoffre = ligneoffre + 1  'incrémenter le N de ligne où copier la machine
          ligneselect = ligneselect + 1 'incrementer le N° de ligne de la machine
 
 
          Sheets("Selection").Activate
          Range("E" & ligneselect).Select
Wend
 
Sheets("offre client").Activate
Range("A18").Select
While ActiveCell.Value <> "B"
    Selection.Offset(1, 0).Activate
Wend
pB = ActiveCell.Row
 
Dim sommach As String
sommach = "=sum(E19:E" & ligneoffre & ")"
Range("E" & pB).Formula = sommach
  ' MsgBox ("machines créées " & ligneoffre & "  " & sommach)
 
                    '**************
                    'création des lignes d'options
                    '**************
 
Sheets("Offre client").Activate
Range("A28").Select
    While ActiveCell.Value <> "D"
        Selection.Offset(1, 0).Activate
    Wend
ligneoffre = ActiveCell.Row + 1
'MsgBox ("ligne offre:" & ligneoffre)
 
Sheets("Selection").Activate
Range("A15").Select
    While ActiveCell.Value <> "Options"
        Selection.Offset(1, 0).Activate
    Wend
ligneselect = ActiveCell.Row + 1
'MsgBox ("ligne selection :" & ligneselect)
 
Range("c" & ligneselect).Select
 
Dim N As Integer
N = 1
    While ActiveCell.Value <> "" 'tant qu'il y a une option
            Sheets("Offre client").Activate
            Rows(ligneoffre).Select
            Selection.Copy
            Rows(ligneoffre + 1).Select
            Selection.Insert shift:=xlDown
 
 
                'on copie les valeurs
           'créer N° de ligne d'offre en B
            Worksheets("Offre client").Cells(ligneoffre, "b") = "Op" & N
           Worksheets("Offre client").Cells(ligneoffre, "c") = Worksheets("Selection").Cells(ligneselect, "g")
           Worksheets("Offre client").Cells(ligneoffre, "e") = Worksheets("Selection").Cells(ligneselect, "n")
 
          ligneoffre = ligneoffre + 1  'incrémenter le N de ligne où copier la machine
          ligneselect = ligneselect + 1 'incrementer le N° de ligne de la machine
          N = N + 1
 
 
          Sheets("Selection").Activate
          Range("c" & ligneselect).Select
    Wend
Application.CutCopyMode = False
Sheets("offre client").Activate
ActiveSheet.PageSetup.LeftFooter = ""
ActiveSheet.PageSetup.CenterFooter = ""
ActiveSheet.PageSetup.RightFooter = ""
MsgBox ("L'offre a été actualisée.")
 
 
'Dim formulenom As Variant
'formulenom = "=RECHERCHEV(Selection!G2;'Historique-'!S63:V65;2;FAUX)"
'ActiveSheet.PageSetup.LeftFooter = formulenom
Dim Police As String
Dim Taille As String
Dim TexteLeft As String
Dim TexteCenter As String
Dim TexteRight As String
 
 Police = "Arial"
Taille = 6
TexteLeft = Range("A1").Value
TexteCenter = Range("A3").Value
TexteRight = Range("A2").Value
'MsgBox (TexteLeft & "  " & TexteCenter & "  " & TexteRight)
    ActiveSheet.PageSetup.LeftFooter = "&""" & Police & ",normal""" & "&" & Taille & TexteLeft
    ActiveSheet.PageSetup.CenterFooter = "&""" & Police & ",normal""" & "&" & Taille & TexteCenter
    ActiveSheet.PageSetup.RightFooter = "&""" & Police & ",normal""" & "&" & Taille & TexteRight
 
'réactive ouverture des onglets
Application.ScreenUpdating = True
 
End Sub

J'ai ajouté ce matin, en ligne 167-169 du code pour mettre à 0 les 3 zones du pied, histoire d'être sûr d'écrire sur du vierge. Mais pas mieux.
J'ai mis les lignes dans l'ordre pour écrire dans le pied dans l'ordre d'écriture : gauche, puis centre, puis droite. Pas mieux
Si je teste chaque ligne l'une après l'autre, en inhibant les 2 autres, le texte ce place bien.
Si j'inhibe 1 seule ligne, les 2 autres se placent bien.
Mais les 3 lignes ensembles, rien à faire, il colle toujours le texte de la dernière ligne au centre (que ce soit leftfooter, center ou right dans la dernière ligne)

Avouez que c'est frustant !

Merci d'avance pour votre analyse

29/01/2020, 10h25
Menhir
A ta place, je commencerais par supprimer Application.ScreenUpdating = False qui n'a rien à faire dans un code en cours de développement.

Ensuite, je simplifierais au maximum les trois lignes :
Code:

1 2 3 ActiveSheet.PageSetup.LeftFooter = "A" ActiveSheet.PageSetup.CenterFooter = "B" ActiveSheet.PageSetup.RightFooter = "C"
Si ces lignes simplifiées fonctionnent bien, j'y inclurais un par un les éléments supplémentaires en faisant des tests à chaque fois pour localiser l'élément perturbateur.

Ben ouai, retour aux bonnes pratiques : 1 pierre à la fois...ça m'apprendra à vouloir faire le kéké...
Je fini avec ça :
Code:

1 2 3 4 5 6 7 8 9 10 11 Dim TexteLeft As String Dim TexteCenter As String Dim TexteRight As String TexteLeft = Range("A1").Value TexteCenter = Range("A3").Value TexteRight = Range("A2").Value ActiveSheet.PageSetup.LeftFooter = "&6" & TexteLeft ActiveSheet.PageSetup.CenterFooter = "&6" & TexteCenter ActiveSheet.PageSetup.RightFooter = "&6" & TexteRight
C'est plus léger, et surtout ça marche au poil!
Merci Menhir et bonne journée

Citation:

Envoyé par Menhir

A ta place, je commencerais par supprimer Application.ScreenUpdating = False qui n'a rien à faire dans un code en cours de développement.[...]

Hum... Que dire? Quels sont tes arguments pour soutenir cela? Sans justifier ta position, c'est un "argument d'autorité", mais nullement un argument technique, et je ne vois personnellement pas ce qui motive ton avis péremptoire :?

Pour compléter les propos de Menhir sur la simplification du code, je découperais la macro crea_offre en petites procédures qui ne font qu'une chose (= qui n'ont qu'une seule responsabilité). Ca permet de tester des codes qui sont courts et que tu peux rendre génériques. Dans le code que tu donnes, tu dois exécuter toute la macro pour tester comment se comporte ton code de remplissage du pied de page.

Crée une procédure qui ne fait que ça, à laquelle tu passes les valeurs. Procède de même pour les autres parties de ton code, puis crée une macro qui enchaine les appels des procédures que tu as écrites et testées. Ton code sera plus lisible, plus maintenable, plus facilement évolutif.
Code:

1 2 3 4 5 Sub CreateFooter(sh As Worksheet, Optional LeftText As String, Optional CenterText As String, Optional RightText As String) If LeftText <> "" Then sh.PageSetup.LeftFooter = LeftText If CenterText <> "" Then sh.PageSetup.CenterFooter = CenterText If RightText <> "" Then sh.PageSetup.RightFooter = RightText End Sub

Bonjour à tous,
Merci Pierre pour ces bons conseils. J'appliquerais sur mes prochaines macro.
Ton retour est parfaitement synchrone, car j'ai vu hier que ce code...fonctionnait toujours mal.
J'ai donc fait une petite sub pour tester :
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 Sub piedpage() Sheets("offre client").Activate 'inserer les valeurs du site vendeur en pied de page Dim TexteLeft As String Dim TexteCenter As String Dim TexteRight As String TexteLeft = Range("A1").Value TexteCenter = Range("A2").Value TexteRight = Range("A3").Value 'TexteLeft = Application.VLookup(Sheets("Selection").Range("g2"), Sheets("Historique-").Range("s63:v65"), 2, False) 'TexteCenter = Application.VLookup(Sheets("Selection").Range("g2"), Sheets("Historique-").Range("s63:v65"), 3, False) 'TexteRight = Application.VLookup(Sheets("Selection").Range("g2"), Sheets("Historique-").Range("s63:v65"), 4, False) MsgBox (TexteLeft & TexteCenter & TexteRight) ActiveSheet.PageSetup.LeftFooter = "&6" & TexteLeft ActiveSheet.PageSetup.CenterFooter = "&6" & TexteCenter ActiveSheet.PageSetup.RightFooter = "&6" & TexteRight End Sub
Dans "selection G2" j'ai une cellule avec liste déroulante. cette liste comporte 3 choix (les nom de 3 usines)
Dans "historique- S63:V65", j'ai un tableau avec les nom des usines, leur adresse, N° de siret et N° de tel. La mise en forme de toutes les cellules de ce tableau est identique.

J'ai testé 2 options :
1-les lignes 10-11-12 où dans A1, A2, A3 je fais des rechercheV pour récupérer adresse, siret et tel selon la selection en "selection G2"
2- les lignes 14-15-16 où je vais chercher directement en "historique- S63:V65"

Grâce au msgbox, je contrôle que mes variables sont correctement remplies, ce qui est toujours le cas.

Le résultat pour mon pied de page est le même pour les 2 options et ... surprenant.

les textes sont correctement appliqués : les bons et au bons endroits. mais environ 1 fois sur 3, le texte de gauche ne se met pas. Quelque soit l'usine sélectionnée.
Si je relance avec la même usine, le texte gauche revient.
je teste une 2ème usine, ça marche
je teste une 3ème usine, ça marche
au 4ème test, rebelote, manque le texte gauche ! Si je relance avec la même usine, le texte gauche revient.
Et à nouveau, je peux enchaîner 2 ou 3 essais corrects avant que de nouveau le texte gauche ne manque à l'appel.

Cela ce produit, quelque soit l'usine sélectionnée, et à chaque fois, msgbox me confirme que mes variables sont bien valorisées.

J'en déduit que c'est un pb sur l'écriture du pied, lignes 20-21-22
Quand texte gauche manque, j'ai vérifié que ce n'était pas un pb d'affichage en allant vérifier l'absence du texte dans le pied de page (via le menu dans excel).
Le fait que le pb apparaisse sur les 3 usines, élimine un pb de taille de texte (certains textes sont plus grands que d'autres, sur 1, 2 ou 3 lignes).

Merci de votre aide
Benoit

07/02/2020, 10h43
Menhir

Citation:

Envoyé par Pierre Fauconnier

Hum... Que dire? Quels sont tes arguments pour soutenir cela? Sans justifier ta position, c'est un "argument d'autorité", mais nullement un argument technique, et je ne vois personnellement pas ce qui motive ton avis péremptoire :?

Cette instruction est très utile dans un code finalisé pour accélérer l'exécution et éviter certains phénomènes visuellement désagréables.

En revanche, pour un code en cours de développement, elle masque certains phénomènes lorsqu'ils se produisent et peut, dans certains cas, compliquer la compréhension de résolution d'un bug.
Sans compter qu'en cours de développement, elle n'a pas grand intérêt puisque la vitesse d'exécution a une importance moindre que pour l'utilisation courante qui sera faite à la fin de la phase de développement.

C'est la raison pour laquelle je déconseille de la placer dans un code en cours de développement et de la réserver aux code finalisés et fiables.
Comme ce n'était qu'un détail mineur dans la recherche de la résolution de ce problème, je n'ai pas cru nécessaire d'y ajouter une longue explication.

A titre personnel (et là, ce n'est qu'un avis totalement subjectif), même avec un code finalisé, j'utilise rarement cette instruction car j'aime "voir ce qui se passe" au cours de l'exécution, l'utilisation de variables plutôt que de Select et Activate limitant les phénomènes désagréables dont je parlais plus haut.
Mais ça, c'est mon propre sentiment et je comprends que d'autres aient un autre ressenti et d'autres méthodes.
07/02/2020, 10h52
Pierre Fauconnier

&6, c'est quand même fort petit, mais bon, c'est normalement visible.

Cela dit, j'ai le même souci que toi (XL 365). Je modifie le pied de page, si je le teste en VBA, j'ai bien la bonne valeur, mais l'affichage et l'impression laissent l'ancien :?

Citation:

Envoyé par Menhir

[...]

Pas du tout convaincu sur le plan technique, mais le lecteur se fera son propre avis ;)
07/02/2020, 11h04
Pierre Fauconnier

Peux-tu donner ici les valeurs que tu utilises "lorsque cela ne fonctionne pas"? Ces valeurs contiennent-elles des &, par exemple? Dans la mesure où seul ton leftfooter semble se comporter de la sorte, c'est peut-être qu'il a reçu une "crasse"?

Sur un nouveau classeur, je ne parviens plus à répéter l'erreur. C'est peut-être que le leftfooter a reçu un truc pas très net à un moment donné et qu'il ne s'en sort pas.
07/02/2020, 12h15
BenoitL77

Merci pour ton retour Pierre,
Et "ravi" que tu ai aussi eu le pb. Au moins ça prouve mes dires.
Ci dessous les textes.

les gauches
"Tecma Pack
11A Boulevard de la Marne
F-77120 Coulommiers"

"Aries Packaging
Rue Louis-François Armand
F-10430 Rosières-près-Troyes"

"Tecma Aries America,
1919 Mc Kinney Avenue,
Dallas, TX 75201"

les centre
"Code APE 3320C - Siret 353 850 118 00038
Identifiant TVA FR 20 353 850 118 - S.A.S au Capital de 2.975.000 €"

"Code NAF 2829A – Siret 387 894 835 00025
N°TVA FR 58 387 894 835 – SAS au capital de 750 000 €"

" - "

les droite
"Tel : +33 (0) 1 64 04 51 80
Fax: +33 (0) 1 64 20 93 83
sales@tecma-aries.com"

"Tel : +33 (0) 3 25 71 39 00
Fax: +33 (0) 3 25 72 93 72
sales@tecma-aries.com"

"Tel : +1 214-720-8974"

Je vais essayer de repérer si d'aventure le pb surviendrait après la sélection d 'une usine en particulier. ce qui voudrait dire que le soucis serait sur cette machine.
En écrivant cette réponse, je me dis que c'est peut être le "-" dans le centre de la 3ème usine qui fout le bazar...
Je test et te redis

Peut être pourrait'on purger les footer avant d'y affecter mes textes?

Merci
07/02/2020, 12h21
Pierre Fauconnier

Je pencherais plus pour des codes de retour à la ligne, mais lorsque j'ai eu le problème, je n'avais pas testé de retour à la ligne.

Pour être franc (cfr la remarque de Menhir sur le ScreenUpdating), je l'avais passé à False sans le repasser à True en fin de macro. Je ne saurais pas dire si c'est cela qui a foutu le bazar car j'ai réessayé sur des autres classeurs de la même façon sans avoir de soucis... Le mystère reste entier...

Pour moi, la façon de purger une zone d'entête ou de pied de page est de lui passer une chaine vide et cela n'avait pas résolu le problème que j'ai rencontré tout à l'heure...
07/02/2020, 12h30
BenoitL77

Bon, à priori, le pb viendrait de la 1ère usine : Tecma pack

Je la sélectionne, fait tourner la macro, pied de page ok. Je relance la macro, pied de page tjrs ok
je sélectionne une autre usine : manque texte gauche. je relance la macro, texte gauche revient.

ça ce vérifie à chaque fois : la selection faite après avoir sélectionné tecma pack n'affiche pas le texte gauche.

j'ai testé en supprimant le @ dans les adresses mail : pas mieux
j'ai vérifié que je n'avais pas de retour ligne dans mes texte : il n'y en avait pas...

le "-" dans la 3ème usine ne semble pas lui poser de pb. Dommage, je tenais là un coupable facile à éliminer...

J'essaye de purger après la pause

A+
07/02/2020, 13h54
BenoitL77
A défaut d'avoir trouvé la cause, j'ai trouvé une solution.

J'ai ajouté
Code:

1 2 3 ActiveSheet.PageSetup.LeftFooter = "" ActiveSheet.PageSetup.CenterFooter = "" ActiveSheet.PageSetup.RightFooter = ""
en début de sub.

Et ça fonctionne!
Et bien que le pb soit dans leftfooter, purger juste leftfooter, ne suffisait pas. Il a fallu purger les 3 sections du pied.
La cause est peut être caché dans les textes centre ou droit...

J'ai réintégré ma petite sub de test dans la principale...:roll: heu non, pardon, j'ai suivi tes conseils et ma sub principale appelle la sub "piedpage" 8-)
... et ça marche toujours et même avec la désactivation/activation du screenupdating.

Y'a du soleil, c'est le week end et ma macro fonctionne !

Merci beaucoup pour le coup de main
Benoit
07/02/2020, 15h41
Pierre Fauconnier

Merci pour ce retour de tests. C'est toujours bon à savoir ;)