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
| ublic Sub RECAP_DISPO_BEN()
Rem ********************************************************************************************
Rem Creation tableau faisant une synhèse des 1/2 journées de disponibilités des bénévoles****
Rem ********************************************************************************************
Rem
Rem Tableau :
Rem ordonnée (colonne) : tous les bénévoles triés (géré par "i" (0 à nombre de bénévole - 1))
Rem abscisse (ligne) : les 10 demis journées "j" de 0 à 9
Rem cellule
Rem Tâche 0 : calcul nombre de bénévoles
Rem Tache 1 : tri
Rem tâche 2 : mise à jour du tableau en traitant les ("CheckBox26") à ("CheckBox35") pour chaque bénévole
Rem tache 3 creation fichier avec tableau
Rem
Rem
Rem
Dim ws As Worksheet
Set ws = Sheets("BASE De GESTION")
Rem
Rem Tâche 0 : calcul nombre de bénévoles
Rem
Dim calcul_limite_table_ben As Integer
Dim ligne_benevole_competence As Integer
With Worksheets("BASE DE GESTION")
calcul_limite_table_ben = ws.Range("A" & Rows.Count).End(xlUp).Row
End With
calcul_limite_table_ben = calcul_limite_table_ben + 1
Rem
Rem tri
Rem
With Worksheets("BASE DE GESTION")
.sort.SortFields.Clear
.sort.SortFields.Add key:=Range("A1:A" & calcul_limite_table_ben), sorton:=xlSortOnValues, order:=xlAscending, dataoption:=xlSortNormal
With .sort
.SetRange Range("A1:AZ" & calcul_limite_table_ben)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
Rem
Rem déclaration tableau
Rem
Dim nom As String ' j=0
Dim prenom As String ' j= 1
Dim check_26 As String ' j = 2
Dim check_27 As String ' j = 3
Dim check_28 As String ' j = 4
Dim check_29 As String ' j = 5
Dim check_30 As String ' j = 6
Dim check_35 As String ' j = 7
Dim check_31 As String ' j = 8
Dim check_32 As String ' j = 9
Dim check_33 As String ' j = 10
Dim check_34 As String ' j = 11
'Dim tableau((12), (12), (4), (4), (4), (4), (4), (4), (4), (4), (4), (4)
'Dim tableau(nom(12), prenom(12), check_26(1), check_27(1), check_28(1), check_29(1), check_30(1), check_35(1), check_31(1), check_32(1), check_33(1), check_34(1))
Dim tableau(0 To 30, 0 To 12)
Rem 100 bénévoles (limitenon utilisé dans la création du tableau
Rem 12 champs ( nom, prénom et 10 demi jounées
Rem Tâche 2 : effacement de toutes les valeurs : inutile car on recree tout
Rem
Rem
Rem-----Chargement du tableau -----------------
Dim i As Integer
For i = 0 To (calcul_limite_table_ben - 1)
nom = ws.Cells((i + 2), "B")
prenom = ws.Cells((i + 2), "C")
check_26 = ws.Cells((i + 2), "S")
check_27 = ws.Cells((i + 2), "T")
check_28 = ws.Cells((i + 2), "U")
check_29 = ws.Cells((i + 2), "V")
check_30 = ws.Cells((i + 2), "W")
check_35 = ws.Cells((i + 2), "X")
check_31 = ws.Cells((i + 2), "Y")
check_32 = ws.Cells((i + 2), "Z")
check_33 = ws.Cells((i + 2), "AA")
check_34 = ws.Cells((i + 2), "AB")
tableau(i, 1) = nom
tableau(i, 2) = prenom
tableau(i, 3) = check_26
tableau(i, 4) = check_27
tableau(i, 5) = check_28
tableau(i, 6) = check_29
tableau(i, 7) = check_30
tableau(i, 8) = check_35
tableau(i, 9) = check_31
tableau(i, 10) = check_32
tableau(i, 11) = check_33
tableau(i, 12) = check_34
Next i
MsgBox "début impression"
'--------------------------------------------
'--------------------------------------------
Dim j As Integer '
Dim sRepertoire As String
Dim sNomFichier As String
Dim sTableau As Variant
' Création d'un fichier texte avec la commande WRITE
' et saut de ligne dans le fichier texte
Dim iFile As Integer
Dim str As Variant
Dim zpourdebug As String
Dim ar As Variant
sRepertoire = "C:\utilisateurs\recapappliben\" '// doit terminer avec un "\"
sNomFichier = "Dispo_ben.txt" '// nom du fichier
On Error Resume Next
Kill sRepertoire & sNomFichier '// effacer le fichier existant
iFile = FreeFile
Open sRepertoire & sNomFichier For Output As #iFile '// crée le fichier texte
ar = tableau()
'// valeurs dans un array (plus rapide)
For i = 1 To UBound(ar, 1) '// boucle sur les lignes
str = ""
For j = 1 To UBound(ar, 2) '// boucle sur les colonnesstr = tableau(i, j) & vbTab '// valeurs séparées par tabulations
' str = str&ar(i,j)&vbTab
'str = ar(i, j) & vbTab
str = ar(i, j) & vbTab
Next j
Write #iFile, str(i) '// écrire dans le fichier
'zpourdebug = str(i)
' Debug.Print zpourdebug
' Print #iFile, str
MsgBox " NOM ", vbTab
Next i
Write #iFile, str(i)
'zpourdebug = str(i)
' Debug.Print zpourdebug
Close #iFile '// Fermer le fichier
' On Error GoTo 0
End Sub |
VBA excel : Outils de test utile : cet outillage méthodologique est centré sur la gestion de fichiers
Répondre avec citation
Envoyé par EddiGordo
Partager