Importer des fichiers Excel avec plusieurs feuilles

**lourid** · 29/12/2022, 23h51

Bonsoir
oui se vrai Toutes les feuilles sont parcourues et toutes les lignes sont importées dans la tbl
mais la colonne cod soc doit rapporter 4400,4401,4403 etc etc
je joins un fichier avec tbl comme il se doit

Envoyé par hyperion13

sérieusement, cela fait un bail que j'ai compris qu'il fallait importer toutes les feuilles !

le fichier *.xslx que vous avez déposé ne contient que 11 feuilles.
pour autant la sub() du Post#15 fonctionne. Toutes les feuilles sont parcourues et toutes les lignes sont importées dans la tbl !

voir img.
le compte 194 lignes !
Et n'oubliez pas de corriger les en-têtes de la Col F (indirizzo versus indrizzo) !

**hyperion13** · 30/12/2022, 06h10

Euh ...

Et si c'est le champ ID qui vous pose problème, vous le supprimer de la tbl !

Envoyé par lourid

...mais la colonne cod soc doit rapporter 4400,4401,4403 etc etc ...

**lourid** · 30/12/2022, 20h32

no même si je supprime l'id ,ça me ramène les données non réparties par cod soc
le code soc change non et pour toutes les lignes 4400
j'espère que j'ai été clair

Envoyé par hyperion13

Euh ...

Et si c'est le champ ID qui vous pose problème, vous le supprimer de la tbl !

**hyperion13** · 31/12/2022, 06h42

re,
désolé, mais je ne comprends plus rien ! Et je ne dois pas être le seul ici !

les Codice Soc sont tous présents !

**deedolith** · 31/12/2022, 13h39

Envoyé par lourid

Bonsoir
oui se vrai Toutes les feuilles sont parcourues et toutes les lignes sont importées dans la tbl
mais la colonne cod soc doit rapporter 4400,4401,4403 etc etc
je joins un fichier avec tbl comme il se doit

Heu .... Es-tu bien conscient que dans une base de données, l'ordre des lignes n'a aucune importance, et ne doit pas en avoir ?

C'est le boulot des requêtes de faire du tri, des filtres, des regroupement ect ect ....

**hyperion13** · 31/12/2022, 18h44

@deedolith
Si Codice Soc doit être importé dans l'ordre, autant trier les feuilles avant (L35/L42) !

EDIT : (L35/L42) ne servent à rien, car même si les feuilles ne sont pas dans un ordre ASC/DESC, l'importation se fait en ASC !

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
Option Explicit
#Const IsLateBinding = True
 
Private Sub btnImportXL_Click()
On Error GoTo btnImportXL_Err
 
#If IsLateBinding Then
    Dim xlApp As Object
    Dim xlWbk As Object
    Dim xlWst As Object
    Set xlApp = CreateObject("Excel.Application")
#Else
    'Early binding Nécessite Microsoft Excel xx.x Object Library
    Dim xlApp As Excel.Application
    Dim xlWbk As Excel.Workbook
    Dim xlWst As Excel.Worksheet
    Set xlApp = New Excel.Application
#End If
 
Dim strFilePath As String, strTableName As String, strSheetName As String
Dim strImportAddress As String, strImportSheetAddress As String
Dim shtCount As Long, i As Long, j As Long, lastRow As Long, lastCol As Long
Dim rngImport As Range
Dim StartTime As Double
 
strFilePath = "C:\Users\Desktop\backup\Nuova cartella\PatInail rev 3.xlsx"
strTableName = "PAT"
 
Set xlWbk = xlApp.Workbooks.Open(strFilePath)
 
shtCount = xlWbk.Worksheets.Count
 
StartTime = Timer
 
If shtCount = 1 Then Exit Sub
For i = 1 To shtCount
    For j = 1 To shtCount - 1
        If xlWbk.Worksheets(j).Name > xlWbk.Worksheets(j + 1).Name Then
            xlWbk.Worksheets(j).Move After:=xlWbk.Worksheets(j + 1)
        End If       
    Next j
Next i
 
For i = 1 To shtCount
    Set xlWst = xlWbk.Worksheets(xlWbk.Worksheets(i).Name)
    strSheetName = xlWst.Name
    With xlWst
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        Set rngImport = .Range(.Cells(1, 1), .Cells(lastRow, lastCol))
        strImportAddress = WorksheetFunction.Substitute(rngImport.Address, "$", "")
        strImportSheetAddress = strSheetName & "!" & strImportAddress
        Call DoCmd.TransferSpreadsheet(acImport, 10, strTableName, strFilePath, True, strImportSheetAddress)
    End With
Next i
 
MsgBox "durée du traitement: " & Timer - StartTime & " secondes"
 
btnImportXL_Exit:
    On Error Resume Next
    Set xlWst = Nothing
    xlWbk.Close False
    Set xlWbk = Nothing
    xlApp.Quit
    Set xlApp = Nothing
    Exit Sub
btnImportXL_Err:
    MsgBox Err.Description, , "Erreur " & Err.Number
    Resume btnImportXL_Exit
End Sub

**lourid** · 02/01/2023, 21h12

ok maintenant et parfait ça marche.

Je demande une dernière chose comment fermer excel reste ouvert

Envoyé par hyperion13

@deedolith
Si Codice Soc doit être importé dans l'ordre, autant trier les feuilles avant (L35/L42) !

EDIT : (L35/L42) ne servent à rien, car même si les feuilles ne sont pas dans un ordre ASC/DESC, l'importation se fait en ASC !

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
Option Explicit
#Const IsLateBinding = True
 
Private Sub btnImportXL_Click()
On Error GoTo btnImportXL_Err
 
#If IsLateBinding Then
    Dim xlApp As Object
    Dim xlWbk As Object
    Dim xlWst As Object
    Set xlApp = CreateObject("Excel.Application")
#Else
    'Early binding Nécessite Microsoft Excel xx.x Object Library
    Dim xlApp As Excel.Application
    Dim xlWbk As Excel.Workbook
    Dim xlWst As Excel.Worksheet
    Set xlApp = New Excel.Application
#End If
 
Dim strFilePath As String, strTableName As String, strSheetName As String
Dim strImportAddress As String, strImportSheetAddress As String
Dim shtCount As Long, i As Long, j As Long, lastRow As Long, lastCol As Long
Dim rngImport As Range
Dim StartTime As Double
 
strFilePath = "C:\Users\Desktop\backup\Nuova cartella\PatInail rev 3.xlsx"
strTableName = "PAT"
 
Set xlWbk = xlApp.Workbooks.Open(strFilePath)
 
shtCount = xlWbk.Worksheets.Count
 
StartTime = Timer
 
If shtCount = 1 Then Exit Sub
For i = 1 To shtCount
    For j = 1 To shtCount - 1
        If xlWbk.Worksheets(j).Name > xlWbk.Worksheets(j + 1).Name Then
            xlWbk.Worksheets(j).Move After:=xlWbk.Worksheets(j + 1)
        End If       
    Next j
Next i
 
For i = 1 To shtCount
    Set xlWst = xlWbk.Worksheets(xlWbk.Worksheets(i).Name)
    strSheetName = xlWst.Name
    With xlWst
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        Set rngImport = .Range(.Cells(1, 1), .Cells(lastRow, lastCol))
        strImportAddress = WorksheetFunction.Substitute(rngImport.Address, "$", "")
        strImportSheetAddress = strSheetName & "!" & strImportAddress
        Call DoCmd.TransferSpreadsheet(acImport, 10, strTableName, strFilePath, True, strImportSheetAddress)
    End With
Next i
 
MsgBox "durée du traitement: " & Timer - StartTime & " secondes"
 
btnImportXL_Exit:
    On Error Resume Next
    Set xlWst = Nothing
    xlWbk.Close False
    Set xlWbk = Nothing
    xlApp.Quit
    Set xlApp = Nothing
    Exit Sub
btnImportXL_Err:
    MsgBox Err.Description, , "Erreur " & Err.Number
    Resume btnImportXL_Exit
End Sub

**hyperion13** · 03/01/2023, 09h29

re,
en L56 ajoutez

Code :

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

1
2
xlApp.ActiveWorkbook.Close Savechanges:=False ' ou True !
xlApp.Quit

**tee_grandbois** · 03/01/2023, 19h03

bonsoir,
bonne année

Envoyé par hyperion13

re,
en L56 ajoutez

Code :

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

1
2
xlApp.ActiveWorkbook.Close Savechanges:=False ' ou True !
xlApp.Quit

la commande Quit existe déjà en ligne 64 et, sauf preuve du contraire, le code y passe après le Msgbox, c'est donc certainement une instance créée par ailleurs qui n'a pas été fermée correctement (peut-être lors de la phase de tests du code ?)

**lourid** · 04/01/2023, 15h12

bonjour e bonne année
ok résolu

Envoyé par tee_grandbois

bonsoir,
bonne année
la commande Quit existe déjà en ligne 64 et, sauf preuve du contraire, le code y passe après le Msgbox, c'est donc certainement une instance créée par ailleurs qui n'a pas été fermée correctement (peut-être lors de la phase de tests du code ?)

**User** · 12/01/2023, 21h13

Bonsoir à tous,

Pour info, si Excel est déjà ouvert on peut aussi tenter de récupérer l'instance de l'application Excel avec un horrible :

Code :

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

1
2
3
On Error Resume Next   
Set xlApp = Getobject(, "Excel.Application")
...

https://learn.microsoft.com/fr-fr/of...bject-function

Cdlt

Importer des fichiers Excel avec plusieurs feuilles [AC-2016]

VBA Access

Discussions similaires

Partager

Partager