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
|
Option Compare Database
Option Explicit
'Evenement sur click génération fichier MOH_P
Private Sub btn_genMOH_Click()
'Déclaration variable
Dim db As Database
Set db = CurrentDb()
'Requetes
Dim wLv_SqlSelectDonneesAdresses As String, wLv_SqlSelectDonneesClients As String, wLv_SqlSelectDonneesCadrans As String, wLv_SqlSelectDonneesNomsManuel As String
'RecordSet
Dim wLt_donneesAdresses As Recordset, wLt_donneesClients As Recordset, wLt_donneesCadrans As Recordset
'All
Dim wLv_PDL As String, wLv_cheminFichier As String
Dim i As Long, j As Long, k As Long, wLt_nbDonneesAdresses As Long
Dim wLv_random As Integer, wLv_numRows As Integer, wLt_nbDonneesClients As Integer, wLt_nbDonneesCadrans As Integer
Dim wLt_tabStruct() As Variant, wLt_tabXls As Variant
Dim exc As New Excel.Application
'PREMISECHA
Dim wLv_idModLieuConso As String
'Contenu des fichiers
Dim wLv_premisecha As String
'-----------------------------------------------------------------------------
'Recupération des données
'On recupére la liste des fichiers necesaire à l'entreprise MOH_P, ainsi que leur structures
wLt_tabStruct = fonction.tabStruct("MOH_P")
'Données d'adresse
wLv_SqlSelectDonneesAdresses = "SELECT zAdresse.numRue, zAdresse.rue, zAdresse.compRue, zAdresse.codePostal, zAdresse.ville, zAdresse.lieuDit, zAdresse.etage, zAdresse.numApp, zAdresse.GSR, zAdresse.numConcession FROM zAdresse;" 'requete données adresse
Set wLt_donneesAdresses = db.OpenRecordset(wLv_SqlSelectDonneesAdresses) 'fermé en fin de programme
'Données client
wLv_SqlSelectDonneesClients = "SELECT zClient.nom, zClient.prenom, zClient.titre, zClient.dateNais FROM zClient;" 'requete données client
Set wLt_donneesClients = db.OpenRecordset(wLv_SqlSelectDonneesClients) 'fermé en fin de programme
'Données cadran
wLv_SqlSelectDonneesCadrans = "SELECT zCadran.groupe, zCadran.nbCadran FROM zCadran;" 'requete données cadran
Set wLt_donneesCadrans = db.OpenRecordset(wLv_SqlSelectDonneesCadrans) 'fermé en fin de programme
'Récupération du fichier XLS ("Fenetre Parcourir...")
wLv_cheminFichier = openFile.OuvrirUnFichier(Me.Hwnd, "Parcourir", 1, "Fichier Excel", "xls")
'-----------------------------------------------------------------------------
'Traitement des données
'On vérifie que le formulaire contient les infos nécessaires
If wLv_cheminFichier = "" Or IsNull(cbb_catTarif.Value) Then
'Affiche message d'erreur en fonction du cas
If wLv_cheminFichier = "" Then
MsgBox "Vous devez obligatoirement selectionner un fichier Excel", vbOKOnly + vbInformation
ElseIf IsNull(cbb_catTarif.Value) Then
MsgBox "Vous devez obligatoirement selectionner une catégorie de tarif", vbOKOnly + vbInformation
End If
Else
'On ouvre le fichier xls sélectionné
exc.Workbooks.Open (wLv_cheminFichier)
exc.Visible = False
'On compte le nb de lignes dans le fichier (sans compter la cell d'entete)
wLv_numRows = exc.ActiveSheet.UsedRange.Rows.Count - 1
'On stock le contenu du xls dans un Array (ligne, colonne)
wLt_tabXls = exc.ActiveSheet.Range("A1:C" & wLv_numRows).Value
'Initialise la génération de nb aléatoire
Randomize
'-----------------------------------------------------------------------------
'TEST
Dim temps As Double
temps = Timer
'-----------------------------------------------------------------------------
'Boucle de création des fichiers en fonction du nb de ligne ds le fichier xls _
'(on soustrait 1 au nb de ligne car la première ligne d'en-tête n'est pas lu)
j = 1
Do While j <= wLv_numRows - 1
'On controle les données client
'Génération nb aléatoire en fonction du nb de client dispo
wLt_donneesClients.MoveLast 'deplace le curseur sur le dernier enregistrement afin de savoir le nb d'adresse dispo
wLt_nbDonneesClients = wLt_donneesClients.RecordCount - 1 'récupére le nb max de client et retire 1
i = 0
Do While i < 100 'par sécurité on ne boucle que 100fois
wLt_donneesClients.MoveFirst 'replace le RecordSet au début
wLv_random = Int((wLt_nbDonneesClients * Rnd) + 1) 'génére le nb aléatoire ds l'intervalle [0 ; nb adresse]
wLt_donneesClients.Move wLv_random
'On verifie que les champs necessaire sont bien renseigné
If wLt_donneesClients!nom <> "" And wLt_donneesClients!prenom <> "" And wLt_donneesClients!dateNais <> "" Then
'Si aucune option requise
If cb_sexe.Value = 0 Then
Exit Do
'Si option requise
Else
'On verifie que les champs optionel sont renseigné
If wLt_donneesClients!Titre <> "" Then
Exit Do
End If
End If
End If
i = i + 1
Loop
'On controle les données d'adresse
'Génération nb aléatoire en fonction du nb d'adresse dispo
wLt_donneesAdresses.MoveLast 'deplace le curseur sur le dernier enregistrement afin de savoir le nb d'adresse dispo
wLt_nbDonneesAdresses = wLt_donneesAdresses.RecordCount - 1 'récupére le nb max de d'adresse et retire 1
i = 0
Do While i < 100 'par sécurité on ne boucle que 100fois
wLt_donneesAdresses.MoveFirst 'replace le RecordSet au début
wLv_random = Int((wLt_nbDonneesAdresses * Rnd) + 1) 'génére le nb aléatoire ds l'intervalle [0 ; nb adresse]
wLt_donneesAdresses.Move wLv_random
'On verifie que les champs necessaire sont bien renseigné
If wLt_donneesAdresses!rue <> "" And wLt_donneesAdresses!ville <> "" And wLt_donneesAdresses!codePostal <> "" And wLt_donneesAdresses!GSR <> "" And wLt_donneesAdresses!etage <> "" And wLt_donneesAdresses!numApp <> "" And wLt_donneesAdresses!numConcession <> "" Then
Exit Do
End If
i = i + 1
Loop
'On controle les données cadran
'Génération nb aléatoire en fonction du nb de cadran dispo
wLt_donneesCadrans.MoveLast 'deplace le curseur sur le dernier enregistrement afin de savoir le nb de cadran dispo
wLt_nbDonneesCadrans = wLt_donneesCadrans.RecordCount - 1 'récupére le nb max de cadran et retire 1
i = 0
Do While i < 100 'par sécurité on ne boucle que 100fois
wLt_donneesCadrans.MoveFirst 'replace le RecordSet au début
wLv_random = Int((wLt_nbDonneesCadrans * Rnd) + 1) 'génére le nb aléatoire ds l'intervalle [0 ; nb cadran]
wLt_donneesCadrans.Move wLv_random
'On verifie que les champs necessaire sont bien renseigné
If wLt_donneesCadrans!groupe <> "" And wLt_donneesCadrans!nbCadran = optgr_typeApp Then
Exit Do
End If
i = i + 1
Loop
'Generation num PDL
wLv_PDL = fonction.PDL()
'-----------------------------------------------------------------------------
'PREMISECHA -> 4
'Clé externe de la modification
wLv_idModLieuConso = fonction.idModLieuConso(wLv_PDL)
'
'ligne1 -> Identification
wLv_premisecha = wLv_idModLieuConso & vbTab & wLt_tabStruct(4, 1) & vbTab & wLt_tabXls(j, 3) & vbTab & "" & vbTab & "info sup lieu conso" & vbTab & wLt_donneesAdresses!etage & vbTab & wLt_donneesAdresses!numApp & vbCrLf
'ligne2 -> Fin
wLv_premisecha = wLv_premisecha & wLv_idModLieuConso & vbTab & WLV_FIN
'Ecriture du fichiers PREMISECHA
Open CurrentProject.Path & "\PREMISECHA.txt" For Append As #4
Print #4, wLv_premisecha
Close #4
'-----------------------------------------------------------------------------
'Incrémentation pour la boucle de création des fichiers en fonction du nb de PDL inscrit ds le fichier xls
j = j + 1
Loop
'-----------------------------------------------------------------------------
'On ferme les RecordSet
wLt_donneesAdresses.Close
wLt_donneesClients.Close
wLt_donneesCadrans.Close
'Ferme et libère le fichier XLS
exc.ActiveWorkbook.Close
exc.Quit
Set exc = Nothing
'-----------------------------------------------------------------------------
'TEST
MsgBox Timer - temps
'-----------------------------------------------------------------------------
'On affiche un msg confirmant la bonne marche du programme
MsgBox "Fichiers générés avec succès", vbOKOnly + vbInformation
'Fin si de vérification de la selection d'un fichier xls et champs
End If
End Sub |
Optimisation de code, génération de fichiers (.txt et .xls)
Répondre avec citation
Partager