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
| Private plage As Range
Private final1(1 To 1, 1 To 3)
Private final2(1 To 1, 1 To 3)
Private hauteur As Integer
Private largeur As Integer
Private numerocolonne As Integer
Private itération As Integer
Private nligneplantes As Integer
Private larg1palette
Private larg2palette
Private larg1travaux
Private larg2travaux
Option Explicit
Sub TCDexportation()
'Désactivation du rafraichissement de l'écran pour ne pas ralentir la macro
Application.ScreenUpdating = False
'Création des feuilles de travail
'Désactivation de l'affichage des alertes lors de la suppression de feuilles
Application.DisplayAlerts = False
Sheets("Exportation1").Delete
Sheets("Exportation2").Delete
'Réactivation de l'affichage des alertes
Application.DisplayAlerts = True
Sheets.Add.Name = "Exportation1"
Sheets.Add.Name = "Exportation2"
Sheets.Add.Name = "Travail"
Sheets.Add.Name = "Travailbis"
Sheets.Add.Name = "Travailter"
Sheets.Add.Name = "Travail2"
Sheets.Add.Name = "Travail3"
Sheets.Add.Name = "Travail4"
Sheets.Add.Name = "Travail5"
Sheets.Add.Name = "Travail6"
'calcul du nb de Noms de plantes
Worksheets("Nomsplantes").Activate
[A1].Select
Selection.CurrentRegion.Select
nligneplantes = Application.Selection.Rows.count
'Création du TCD qui est automatiquement copié sur Travail3 (voir fonction TCD)
TCD "TCD1", 2, "(Tous)", "(Tous)", 1
'Ajoue de la valeur (tous) à site et station
Cells(1, 1).Select
Selection.EntireRow.Insert
Cells(1, 1) = "(Tous)"
Cells(1, 2) = "(Tous)"
'les cellules site vides à cause de la présence de plusieurs stations pour un site, sont remplie avec le nom du site correspondant
Dim nbstation As Integer
nbstation = Selection.CurrentRegion.Rows.count
Dim i As Integer
For i = 1 To nbstation
If IsEmpty(Cells(i, 1)) Then
Cells(i, 1).Value = Cells(i - 1, 1)
End If
Next
'Initialisation du tableau final2
Dim debut(1 To 1, 1 To 3)
debut(1, 1) = 1
debut(1, 2) = 1
debut(1, 3) = 0
numerocolonne = 1
'Début de la boucle de création en chaîne des TCD pour chaque site et station
For i = 1 To nbstation
itération = i
'Création des TCD palette et travaux complets (station = site = (tous))
If i = 1 Then
Dim site As String
site = Worksheets("Travail4").Cells(i, 1).Text
Dim station As String
station = Worksheets("Travail4").Cells(i, 2).Text
'Création du TCD de palette végétale
TCD "TCD1", 0, (site), (station), 1
'Application du style au tableau obtenu
palette
'Exportation du tableau finalisé
exportation debut(1, 1), debut(1, 2), site, station, 0, i
'De même pour les travaux
TCD "TCD1", 1, (site), (station), 1
travaux
exportation debut(1, 1), debut(1, 2), site, station, 1, i
'Création des TCD palette et travaux site par site et station par station
Else
site = Worksheets("Travail4").Cells(i, 1).Text
station = Worksheets("Travail4").Cells(i, 2).Text
TCD "TCD1", 0, (site), (station), 2
palette
exportation final1(1, 1), final1(1, 2), site, station, 0, i
TCD "TCD1", 1, (site), (station), 2
travaux
exportation final2(1, 1), final2(1, 2), site, station, 1, i
End If
numerocolonne = numerocolonne + largeur + 5 - 1
Next
'Désactivation de l'affichage des alertes lors de la suppression de feuilles
Application.DisplayAlerts = False
Sheets("Travail").Delete
Sheets("Travail2").Delete
Sheets("Travail3").Delete
Sheets("Travail4").Delete
Sheets("Travail5").Delete
Sheets("Travail6").Delete
Sheets("Travailbis").Delete
Sheets("Travailter").Delete
'Réactivation de l'affichage des fenêtres d'alerte
Application.DisplayAlerts = True
'Réactivation du rafraichissement de l'écran
Application.ScreenUpdating = True
End Sub |
Tri personnalisé qui se lance tout seul
Répondre avec citation
Partager