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
| Function ImportFeuillesXLS(pNomClasXLS As String)
'-------------------------------
' paramètres
' pNomClasXLS :nom du classeur
'-------------------------------
Dim xlApp As New Excel.Application
Dim xlWbk As Excel.Workbook
Dim xlWsh As Excel.Worksheet
Dim lgDerlig As Long ' dernière ligne utile de la feuille
Dim lgDerCol As Integer ' denière colonne utile de la feuille
Dim F As Integer, C As Integer
Dim J As Integer, K As Integer, L As Integer
'Données fixes
Dim strClient As String ' Nom du Client
Dim strBatiment As String ' Nom du Batiment
Dim strPoste As String ' Nom du Poste
Dim strLettreCongelo As String ' Nom du LettreCongelo
Dim strNomDemandeur As String ' Nom du NomDemandeur
Dim strHeureLivSouhaite As String ' HeureLivSouhaite
Dim strTelDemandeur As String ' TelDemandeur
'Données variables
Dim boRupture As Boolean ' Indicateur de la rupture: première cellule vide en colonne 1
Dim stListeReferencePR As String ' Nom du congélo
Dim tabloRefPR() As String
Dim stListeQuantitéCommandee As String ' Liste valeurs références et tableau associé
Dim tabloQuantitéCommandee() As String
Dim oRst As Recordset ' Table à remplir
Set xlWbk = xlApp.Workbooks.Open(pNomClasXLS)
'-----------------------------------------------------
' Excel visible pour les tests
'xlApp.Visible = True
' Ouverture table
Set oRst = CurrentDb.OpenRecordset("tbl_Taxi", dbOpenDynaset)
For F = 1 To xlWbk.Sheets.Count
' chargement de la 1ère feuille
Set xlWsh = xlWbk.Worksheets(F)
' on ne traite pas la feuille nommée "Total"
'If xlWsh.Name = "Total" Then Exit For
' dernière ligne utile de la feuille
lgDerlig = xlWsh.UsedRange.Rows.Count
' dernière colonne utile de la feuille
lgDerCol = xlWsh.UsedRange.Columns.Count
For L = 1 To lgDerlig
' rupture sur le type de produit
If xlWsh.Cells(L, 1) = "" Then
boRupture = True
Else 'Else xlWsh.Cells(L, 1) = ""
If boRupture = True Then
strClient = xlWsh.Cells(L, 1)
boRupture = False
' on ne traite pas les cellules de totalisation, on "force" la lecture de la dernière ligne
' If strProduit = "Total" Then
' L = lgDerlig
' Exit For
' End If
Else 'Else boRupture = True
'copie des intitulés des colonnes conditionnement
If xlWsh.Cells(L, 1) = "Heure de livraison souhaité" Then
stListeReferencePR = ""
For C = 2 To lgDerCol
If xlWsh.Cells(L, C) <> "" And xlWsh.Cells(L, C) <> "Produit périmé" And xlWsh.Cells(L, C) <> "Observation" Then
stListeReferencePR = stListeReferencePR & xlWsh.Cells(L, C) & "|"
End If
Next C
' tableau des références produit
tabloRefPR = Split(CStr(Left(stListeReferencePR, Len(stListeReferencePR) - 1)), "|")
ReDim Preserve tabloRefPR(UBound(tabloRefPR))
Else 'Else xlWsh.Cells(L, 1) = "CONDITIONNEMENT"
' tableau des valeurs: 2 fois le nombre de Référence + la colonne 1
If xlWsh.Cells(L, 1) <> "" Then
For C = 0 To (UBound(tabloRefPR) + 1) * 2
stListeQuantitéCommandee = stListeQuantitéCommandee & xlWsh.Cells(L, C + 1) & "|"
' colonne suivante
Next C
' remplissage du tableau et redimensionnement
tabloQuantitéCommandee = Split(CStr(Left(stListeQuantitéCommandee, Len(stListeQuantitéCommandee) - 1)), "|")
ReDim Preserve tabloQuantitéCommandee(UBound(tabloQuantitéCommandee))
' Chargement des données dans la table
' traitement pour une ligne de la feuille
For K = 1 To UBound(tabloRefPR) + 1
oRst.AddNew
oRst.Fields("Client") = strClient 'ex.: "R - poste 271 étage 2 - G39"
oRst.Fields("Batiment") = strBatiment 'ex.: "R - poste 271 étage 2 - G39"
oRst.Fields("Poste") = strPoste
oRst.Fields("LettreCongélo") = strLettreCongelo
oRst.Fields("NomDemandeur") = strNomDemandeur
oRst.Fields("HeureLivSouhaite") = strHeureLivSouhaite
oRst.Fields("TelephoneDemandeur") = strTelDemandeur
oRst.Fields("Conditionnement") = tabloQuantitéCommandee(0) 'ex.: "1782 C48"
oRst.Fields("ReferencePR") = tabloRefPR(K - 1) 'ex.: "CART 170CC" (col. 0 du tableau tabloRef)
oRst.Fields("QuantitéCommandee") = Val(tabloRefPR(K * 2 - 1)) 'ex.: "20" (col. 0+n du tableau tabloValRef)
oRst.Update
Next K
' vidage des valeurs stockées
stListeValRef = ""
End If 'If xlwsh.Cells(L, 1) <> ""
End If 'If xlWsh.Cells(L, 1) = "CONDITIONNEMENT"
End If 'If boRupture = True
End If 'If xlWsh.Cells(L, 1) = ""
' ligne suivante
Next L
' feuille suivante, initialisation des variables
strClient = ""
stListeReferencePR = ""
stListeQuantitéCommandee = ""
Next F
' fermeture des objets
Set oRst = Nothing
xlWbk.Close
xlApp.Quit
End Function |
Manipulation des données Excel, le retour!
Répondre avec citation
)
Envoyé par totor92290
?
Partager