Discussion :

[totor92290]

T'es dur!

En effet c'était pas tout bien clean!
Ci-joint le to be.
Je viens de faire in paquet de copier/coller.
Si possible
- recuperation du nom de l'onglet.
- pas de recuperation des champs en fin de tableaux ("produit périmé" et "observation").
- Récupération des tableaux "supplement"
- pas de recuperation de l'onglet "Total"
J'espère que c'est faisable ?

Merci
TotorDeveloppez_com_V4.xlsx

[tee_grandbois]

T'es dur!

c'est juste pour t'alerter sur le fait que si une feuille contient une cellule mal renseignée, décalée, une ligne en plus ou en moins cela peut poser des problèmes sur les traitements futurs ...
A ce stade, je suis obligé de revoir le traitement dans son ensemble, cela risque de me prendre une partie de la soirée.
Pour le moment j'ai d'autres priorités ...

[tee_grandbois]

Voici la dernière version du code, il est testé mais je n'ai pas vérifié toutes les données, j'ai juste fait quelques sondages au hasard. Les valeurs pour "Supplément" ne posent pas de soucis puisque les cellules sont fusionnées: une cellule sur 2 est donc toujours vide.

Pour que cela fonctionne, les pré-requis sont:
1) il faut toujours une ligne blanche entre les blocs c'est ce qui détermine la rupture



2) il ne faut jamais que les colonnes des références (ligne conditionnement) soient vides, c'est ce qui détermine le nombres de valeurs à enregistrer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
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
 
Dim strProduit As String            ' Nom du produit
Dim boRupture As Boolean            ' Indicateur de la rupture: première cellule vide en colonne 1
Dim stListeRef As String            ' Liste des références et tableau associé
Dim tabloRef() As String
Dim stListeValRef As String         ' Liste valeurs références et tableau associé
Dim tabloValRef() 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_Produits", 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
                strProduit = 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) = "CONDITIONNEMENT" Then
                    stListeRef = ""
 
                    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
                            stListeRef = stListeRef & xlWsh.Cells(L, C) & "|"
                        End If
                    Next C
                    ' tableau des références produit
                    tabloRef = Split(CStr(Left(stListeRef, Len(stListeRef) - 1)), "|")
 
                    ReDim Preserve tabloRef(UBound(tabloRef))
                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(tabloRef) + 1) * 2
                            stListeValRef = stListeValRef & xlWsh.Cells(L, C + 1) & "|"
                        ' colonne suivante
                        Next C
 
                        ' remplissage du tableau et redimensionnement
                        tabloValRef = Split(CStr(Left(stListeValRef, Len(stListeValRef) - 1)), "|")
                        ReDim Preserve tabloValRef(UBound(tabloValRef))
 
    ' Chargement des données dans la table
                        ' traitement pour une ligne de la feuille
                        For K = 1 To UBound(tabloRef) + 1
                            oRst.AddNew
                            oRst.Fields("Semaine") = xlWsh.Name                     'ex.: "Lundi"
                            oRst.Fields("Produit") = strProduit                     'ex.: "R - poste 271 étage 2 - G39"
                            oRst.Fields("Conditionnement") = tabloValRef(0)         'ex.: "1782 C48"
                            oRst.Fields("Ref") = tabloRef(K - 1)                    'ex.: "CART 170CC" (col. 0 du tableau tabloRef)
                            oRst.Fields("ValRef1") = Val(tabloValRef(K * 2 - 1))    'ex.: "20" (col. 0+n du tableau tabloValRef)
                            oRst.Fields("ValRef2") = Val(tabloValRef(K * 2))        'ex.: "12" (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
    strProduit = ""
    stListeRef = ""
    stListeValRef = ""
Next F
 
' fermeture des objets
Set oRst = Nothing
xlWbk.Close
xlApp.Quit
 
End Function

[tee_grandbois]

pré-requis 3, il faudrait toujours la mention "CONDITIONNEMENT"



mais on pourrait éventuellement passer outre avec:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
            'copie des intitulés des colonnes conditionnement
                If xlWsh.Cells(L, 1) = "CONDITIONNEMENT" Or Trim(xlWsh.Cells(L, 1)) = "" Then

[totor92290]

IMPECABLE !!!
Merci encore Tee_grandbois.
ça fonctionne parfaitement!

Totor
PS: désolé encore pour les datas tronquées du début, vu le temps que tu y as passé... on ne m'y reprendra plus

[totor92290]

Tu vas me tuer !!!

Le nom du fichier que l'on importe n'est pas toujours le même. De ce fait la ligne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Call ImportFeuillesXLS("C:\Users\Desktop\Excel_Raw_DataCollectionToBeRecorded\Raw_Excel_Report.xlsx")

ne fonctionne plus.
J'aurais souhaité que l'opérateur, à reception du fichier par Email, fasse glisser le fichier excel dans le repertoire "ToBeRecorded" et qu'ensuite, en appuyant sur le bouton, le fichier sois transféré vers la table à l'aide de ton code.
J'ai éssayé comme ça:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Call ImportFeuillesXLS("C:\Users\Desktop\Excel_Raw_DataCollectionToBeRecorded\*.xlsx")

Mais bien entendu, ça ne fonctionne pas.
Ensuite je transferais le fichier vers in repertoire "Recorded"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
Sub AddAllExcelFileWithClick()
 
'*********************Deplacer les fichiers excel
Dim rep As String
 
rep = Dir("C:\Users\Desktop\Excel_Raw_DataCollectionToBeRecorded\*.xls", vbDirectory)
'boucle tant que le répertoire n'a pas été entièrement parcouru
Do While (rep <> "")
 
  sEmplacementFinal = "C:\Users\Desktop\Excel_Raw_DataCollectionRecorded\" & rep
 
  'sEmplacementInitial =
   'MsgBox "Fichier texte : " & rep ' Utiliser FileCopy à la place.
  FileCopy "C:\Users\Desktop\Excel_Raw_DataCollectionToBeRecorded\" & rep, sEmplacementFinal
  'passe à l'élément suivant
     Kill ("C:\Users\Desktop\Excel_Raw_DataCollectionToBeRecorded\" & rep)
    rep = Dir("C:\Users\\Desktop\Excel_Raw_DataCollectionToBeRecorded\*.xls", vbDirectory)
Loop
End Sub

Si quelqu'un a une idée
Totor

[tee_grandbois]

bonjour,

Le nom du fichier que l'on importe n'est pas toujours le même.

Il s'agit d'un autre problème, tu devrais ouvrir une autre discussion ...

[tee_grandbois]

bon finalement, je te donne le code pour traiter les fichiers se trouvant dans un répertoire:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub AddAllExcelFileWithClick()
 
'****** TRAITEMENT DES FICHIERS EXCEL APRES RECEPTION ******
 
Dim strRepTraitement As String      ' Répertoire des fichiers à traiter
Dim strFichier As String            ' Nom du fichier à traiter
Dim strRepArchivage As String       ' Répertoire d'archivage
Dim oFso As Object                  ' File System Object pour déplacement des fichiers traités
 
Set oFso = CreateObject("Scripting.FileSystemObject")
strRepTraitement = "C:\Users\Desktop\Excel_Raw_DataCollectionToBeRecorded\"
strRepArchivage = "C:\Users\Desktop\Excel_Raw_DataCollectionRecorded\"
 
' boucle tant que le répertoire contient les fichiers à traiter
strFichier = Dir(strRepTraitement & "*.xlsx", vbDirectory)
 
Do Until strFichier = ""
' traitement du fichier
    Call ImportFeuillesXLS(strRepTraitement & strFichier)
' déplacement du fichier traité dans répertoire d'Archivage
    oFso.Movefile strRepTraitement & strFichier, strRepArchivage
' fichier suivant
    strFichier = Dir(strRepTraitement & "*.xlsx", vbDirectory)
Loop
 
End Sub

Note que je préfère utiliser MoveFile avec File System Oject plutôt que Kill plus destructeur ...

[totor92290]

Merci Tee_grandbois,
J'ai un message d'erreur
"Sorry, we couldn't find..."
et il me renvoie l'adresse de la ligne qui se trouve dans le code que tu m'avais fait avec Marrot_r

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Call ImportFeuillesXLS("C:\Users\Desktop\Excel_Raw_DataCollectionToBeRecorded\Raw_Excel_Report.xlsx")

C'est peut être du fait que dans le code le nom est "figé", non ?


Merci
Totor

[tee_grandbois]

bonjour,
il faudrait quand même que tu comprennes un minimum le code qu'on te donne ...
Le traitement est appelé directement dans ce code (ligne 19), donc si tu le relances, forcément, il ne trouvera plus les fichiers, d'où le message ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub AddAllExcelFileWithClick()
 
'****** TRAITEMENT DES FICHIERS EXCEL APRES RECEPTION ******
 
Dim strRepTraitement As String      ' Répertoire des fichiers à traiter
Dim strFichier As String            ' Nom du fichier à traiter
Dim strRepArchivage As String       ' Répertoire d'archivage
Dim oFso As Object                  ' File System Object pour déplacement des fichiers traités
 
Set oFso = CreateObject("Scripting.FileSystemObject")
strRepTraitement = "C:\Users\Desktop\Excel_Raw_DataCollectionToBeRecorded\"
strRepArchivage = "C:\Users\Desktop\Excel_Raw_DataCollectionRecorded\"
 
' boucle tant que le répertoire contient les fichiers à traiter
strFichier = Dir(strRepTraitement & "*.xlsx", vbDirectory)
 
Do Until strFichier = ""
' traitement du fichier
    Call ImportFeuillesXLS(strRepTraitement & strFichier)
' déplacement du fichier traité dans répertoire d'Archivage
    oFso.Movefile strRepTraitement & strFichier, strRepArchivage
' fichier suivant
    strFichier = Dir(strRepTraitement & "*.xlsx", vbDirectory)
Loop
 
End Sub

[totor92290]

Tee_grandbois,
En fait mon projet est super mal foutu! c'est le foutoir!
J'ai un formulaire avec in bouton click et in champ date.
Derrière le bouton j'ai le code suivant pour m'assurer que le champ "date" est saisie et que le fichier n'a pas déjà enregistré

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
On Error GoTo Err_Ajout_FichierExcel_Click
 
dt_s1 = Me.DateFichierImport
dt_s2 = DLookup("Date_Fichier_Excel", "T000_tbl_Produits_Cumul", "DateFichierImport='" & dt_s1 & "'")
 
If IsNull(Me!DateFichierImport) Then
    MsgBox "vous devez saisir la date du fichier a importer"
Exit Sub
End If
If dt_s1 = dt_s2 Then
MsgBox "Attention, le fichier excel de cette date a déjà été importé"
 
Else:
'DoCmd.Hourglass True
DoCmd.SetWarnings False
DoCmd.OpenQuery "Q001_Del_tbl_Produits"

J'ai une requette delete pour vider la table avant une nouvelle importation

Ensuite je lance le module AddAllExcelFileWithClick

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Call AddAllExcelFileWithClick

Qui doit transferer les fichier et qui inclus le module

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Call ImportFeuillesXLS(strRepTraitement & strFichier)

Qui permet d'ajouter la table d'origine (excel) vers la table tbl_Produits via une requete ajout

ensuite j'ajoute la table tbl_Produits vers T000

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
  DoCmd.OpenQuery "Q001_Add_tbl_Produits_To_T000"
    DoCmd.SetWarnings True
    MsgBox "Fichier Excel Enregistré"
End If
'DoCmd.Hourglass False
Exit_Ajout_FichierExcel_Click:
    Exit Sub
'
Err_Ajout_FichierExcel_Click:
    MsgBox Err.Description
    Resume Exit_Ajout_FichierExcel_Click
'
''
End Sub

Alors quand je click sur le bouton, le message "fichier excel enregistré" s'affiche mais la table T000 est vide! Je suis largué!
Merci
PS: si tu ne souhaites pas répondre, je comprendrais.

[tee_grandbois]

Bonjour totor92290,

En fait mon projet est super mal foutu! c'est le foutoir!

pas de panique, je pense que ce n'est pas grand chose. Ce n'est pas le foutoir, c'est juste qu'il y a plusieurs étapes à suivre dans l'ordre. Cela peut se comprendre car on n'est jamais à l'abri d'une fausse manip quand on traite des fichiers externes...

J'ai un formulaire avec in bouton click et in champ date.
Derrière le bouton j'ai le code suivant pour m'assurer que le champ "date" est saisie et que le fichier n'a pas déjà enregistré

J'ai une requette delete pour vider la table avant une nouvelle importation

OK, donc, à ce stade il n'y a pas encore le code qui traite les fichiers, il faudrait juste connaitre l'impact de la saisie de ce champ date dans la suite du process.

Ensuite je lance le module AddAllExcelFileWithClick
Qui doit transferer les fichier et qui inclus le module
Qui permet d'ajouter la table d'origine (excel) vers la table tbl_Produits via une requete ajout

à ce stade le fichier tb_produits doit être alimenté: il faut donc vérifier que la requête "Q001_Add_tbl_Produits_To_T000" "voit" les enregistrements.
A la fin du code AddAllExcelFileWithClick tu devrais pouvoir le faire en affichant la requête en mode feuille de données.

S'il ne renvoie aucun enregistrement, il faudrait poster le SQL de "Q001_Add_tbl_Produits_To_T000" pour savoir pourquoi les données ne sont pas intégrées

[totor92290]

Bonjour Tee-grandbois,
bon... je ne sais pas avec exactitude ce que j'ai fait mais ça fonctionne!!
Encore merci pour ton support et surtout... ta patience.

Merci