Epuration de code gain de vitesse
Bonjour,
J'ai ecrit une macro qui permet de vérifier les en têtes et pieds de page avant l'impression.
Le problème est que c'est assez long.
Je suis plutôt débutant en programmation, j'ai appris tout seul il y a quelque semaines donc il y a forcement dese choses que je ne connait pas.
Une autre petite chose, j'aimerai pouvoir aller à la ligne pour cette en tête:
.CenterHeader = "&14" & "Tableau récapitulatif chantier " & chantier & " à fin semaine " & ns ' "&F"
comment faire?
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
| Private Sub Workbook_BeforePrint(Cancel As Boolean)
'Vient controler que le nom des feuilles n'a pas été changé
'Si il a été changé, il renomme les feuilles corectement
'Remet également les en-tête et pied de page par défaut
Dim i As Integer
Dim nom As String
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo fin
For Each Sheet In ThisWorkbook.Sheets
If Sheet.Name = "Feuille de Saisie" Then
ns = Sheet.Cells(1, 9).Value
chantier = Sheet.Cells(1, 4).Value
With Sheet.PageSetup
.LeftHeader = " &G"
.CenterHeader = "&14" & "Tableau récapitulatif chantier " & chantier & " à fin semaine " & ns ' "&F"
.RightHeader = "Date dernière modification : &D"
.LeftFooter = "&F"
.CenterFooter = ""
.RightFooter = ""
End With
Else
With Sheet.PageSetup
.LeftHeader = " &G"
.CenterHeader = "&14" & "BILAN TACHE: " & nom
.RightHeader = "Date dernière modification : &D"
.LeftFooter = "&F"
.CenterFooter = ""
.RightFooter = "Fiche de suivi version finale Imhoff Energies et Santé"
End With
End If
If Sheet.Name = "Feuille de Saisie" Or Sheet.Name = "Feuil1" Then GoTo suite
nom = Sheet.Cells(3, 1).Value
trouve = ""
i = 5
Do Until trouve = nom
trouve = "(" & Sheets("Feuille de Saisie").Cells(i, 1).Value & ") " & Sheets("Feuille de Saisie").Cells(i, 2).Value
i = i + 1
If i = 1000 And trouve <> nom Then
Sheet.Name = Left(Sheet.Cells(3, 1).Value, 18) & " " & Sheet.Cells(3, 17).Value
GoTo suite
End If
Loop
i = i - 1
If Sheet.Name <> "(" & Me.Sheets("Feuille de Saisie").Cells(i, 1).Value & ") " & Left(Me.Sheets("Feuille de Saisie").Cells(i, 2).Value, 15) & " " & Me.Sheets("Feuille de Saisie").Cells(i, 6).Value Then
Sheet.Name = "(" & Me.Sheets("Feuille de Saisie").Cells(i, 1).Value & ") " & Left(Me.Sheets("Feuille de Saisie").Cells(i, 2).Value, 15) & " " & Me.Sheets("Feuille de Saisie").Cells(i, 6).Value
End If
suite:
Next Sheet
fin:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub |
