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
| Function ImportFeuillesXLS_Appro(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 C As Integer ' indice pour colonne
Dim K As Integer ' indice de travail
Dim L As Integer ' indice pour ligne
' variables données -------------------------
Dim dtRequest As String ' date demande
Dim strClient As String ' client
Dim strBatiment As String ' bâtiment
Dim strPoste As String ' poste
Dim strLettreCongelo As String ' lettre congélateur
Dim strNomDemandeur As String ' nom demandeur
Dim strHeureLivSouhaite As String ' date/heure livraison souhaitée
Dim strTelDemandeur As String ' tél. demandeur
Dim strListeRefPR As String ' liste des références produit
' variables tableaux ------------------------
Dim tabloRefPR() As String ' tableau des références produit
Dim tabloCondQte() As String ' tableau des conditionnements et des quantités
Dim oRst As Recordset ' recordset de la table à remplir
'--------------------------------------------
' ouverture fichier excel et desactiver la macro
xlApp.EnableEvents = False
Set xlWbk = xlApp.Workbooks.Open(pNomClasXLS)
xlApp.Visible = True
xlApp.EnableEvents = False
'--------------------------------------------
' chargement de la feuille
Set xlWsh = xlWbk.Worksheets(1)
' dernière ligne utile de la feuille
lgDerlig = xlWsh.UsedRange.Rows.Count
' Dernière colonne utile de la feuille
lgDerCol = xlWsh.UsedRange.Columns.Count
'--------------------------------------------
' récupération des données fixes lignes 20 à 23
dtRequest = xlWsh.Range("J20") ' date demande
strClient = Trim(xlWsh.Range("B22")) ' client
strBatiment = Trim(xlWsh.Range("D22")) ' batiment
strPoste = Trim(xlWsh.Range("F22")) ' poste
strLettreCongelo = Trim(xlWsh.Range("I22")) ' lettre congelateur
strNomDemandeur = Trim(xlWsh.Range("K22")) ' nom demandeur
strHeureLivSouhaite = Trim(xlWsh.Range("D23")) ' date/heure livraison souhaitée
strTelDemandeur = Trim(xlWsh.Range("J23")) ' tél. demandeur
'--------------------------------------------
' récupération des références produits ligne 27
L = 27
For C = 2 To lgDerCol
If xlWsh.Cells(L, C) <> "" Then strListeRefPR = strListeRefPR & xlWsh.Cells(L, C) & "|"
Next C
tabloRefPR = Split(CStr(Left(strListeRefPR, Len(strListeRefPR) - 1)), "|")
'--------------------------------------------
' Alimentation de tabloCondQte, tableau à 2 dimensions
' la première contient les conditionnements, la seconde les quantités.
' Formule pour le redimensionnement de la première dimension du tableau:
' ((nombre total de lignes - ligne de début des données) - 1) * 0.5
' exemple pour le fichier actuel: ((34 - 27) - 1 ) * 0.5
' on enlève 1 car on est en base 0 et comme une ligne sur deux est vide à cause
' des cellules fusionnées on multiplie par 0.5 ce qui équivaut à diviser par 2
L = ((lgDerlig - L) - 1) * 0.5
ReDim tabloCondQte(L, UBound(tabloRefPR) + 1)
K = 28
For L = 0 To UBound(tabloCondQte, 1)
If xlWsh.Cells(L + K, 1) <> "" Then
For C = 0 To UBound(tabloCondQte, 2)
tabloCondQte(L, C) = xlWsh.Cells(L + K, C + 1)
Next C
K = K + 1 ' pour se positionner sur la bonne ligne (évite le problème de fusion de cellules)
End If
Next L
'--------------------------------------------
' Chargement des données dans la table
' ouverture table à alimenter
Set oRst = CurrentDb.OpenRecordset("tbl_Taxi", dbOpenDynaset)
For L = 0 To UBound(tabloCondQte, 1)
K = 0
For C = 0 To UBound(tabloRefPR)
oRst.AddNew
oRst.Fields("Conditionnement") = Trim(tabloCondQte(L, 0))
oRst.Fields("Reference_Produit") = Trim(tabloRefPR(K))
oRst.Fields("Quantite") = Val(tabloCondQte(L, C + 1))
oRst.Fields("Date_Request") = CDate(dtRequest)
oRst.Fields("Client") = strClient
oRst.Fields("Batiment") = strBatiment
oRst.Fields("Poste") = strPoste
oRst.Fields("Lettre_Congelateur") = strLettreCongelo
oRst.Fields("Nom_Demandeur") = strNomDemandeur
oRst.Fields("Date_Heure_Liv_Souhaite") = strHeureLivSouhaite
oRst.Fields("Numero_Tel_Demandeur") = strTelDemandeur
oRst.Update
' référence produit suivant
K = K + 1
Next C
Next L
'--------------------------------------------
' fermeture des objets
Set oRst = Nothing
xlWbk.Close False
xlApp.Quit
End Function |
Récupération fichier excel dans un réseau
Répondre avec citation
)
Partager