IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VBA Access Discussion :

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


Sujet :

VBA Access

  1. #1
    Futur Membre du Club
    Homme Profil pro
    impiegato
    Inscrit en
    mai 2019
    Messages
    79
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Italie

    Informations professionnelles :
    Activité : impiegato

    Informations forums :
    Inscription : mai 2019
    Messages : 79
    Points : 7
    Points
    7
    Par défaut Importer des fichiers Excel avec plusieurs feuilles
    Bonjour a tous
    je voudrais importer un fichier xls avec 13 feuilles dans une table nommée PAT

    J'ai enregistré cette fonction mais je n'importe que la première feuille et cela me donne des erreurs de sauvegarde!!! où est-ce que je me trompe?
    merci a tous

    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
     Function importa()
    ' importa i dati da tutti i fogli excel ------------------------------------------------
    Set DBCorrente = CurrentDb
    Set tabella = DBCorrente.OpenRecordset("PAT", dbOpenDynaset)
     
    Dim SQL_Text As String
    Set xl = CreateObject("Excel.Application")
    sSource = "C:\Users\Desktop\backup\Nuova cartella\PatInail rev 3.xlsx"
    With xl
    .Workbooks.Add
    .Workbooks.Open sSource
    sheetcount = .worksheets.Count
    For x = 1 To sheetcount
    strname = .worksheets(x).Name
    .Sheets(strname).Select
     
    DoCmd.TransferSpreadsheet acImport, 10, "PAT", "C:\Users\Desktop\backup\Nuova cartella\PatInail rev 3.xlsx", True, ""
     
    Next x
    End With
    xl.Application.Quit
     
    End Function

  2. #2
    Rédacteur/Modérateur

    Avatar de User
    Homme Profil pro
    Développeur informatique
    Inscrit en
    août 2004
    Messages
    7 875
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 53
    Localisation : France, Ain (Rhône Alpes)

    Informations professionnelles :
    Activité : Développeur informatique

    Informations forums :
    Inscription : août 2004
    Messages : 7 875
    Points : 18 516
    Points
    18 516
    Billets dans le blog
    38
    Par défaut
    Bonjour,

    Il faut bien préciser le nom de la feuille avec le dernier argument de la méthode :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    '...
    DoCmd.TransferSpreadsheet acImport, 10, "PAT", "C:\Users\Desktop\backup\Nuova cartella\PatInail rev 3.xlsx", True, strname
    '...
    D'autre part je ne pense pas que vous ayez besoin de sélectionner la feuille.

    Cdlt,
    Vous trouverez dans la FAQ, les sources ou les tutoriels, de l'information accessible au plus grand nombre, plein de bonnes choses à consulter sans modération

    Des tutoriels pour apprendre à créer des formulaires de planning dans vos applications Access :
    Gestion sur un planning des présences et des absences des employés
    Gestion des rendez-vous sur un calendrier mensuel


    Importer un fichier JSON dans une base de données Access :
    Import Fichier JSON

  3. #3
    Expert éminent
    Homme Profil pro
    Webplanneur
    Inscrit en
    octobre 2007
    Messages
    3 934
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 58
    Localisation : France, Ain (Rhône Alpes)

    Informations professionnelles :
    Activité : Webplanneur

    Informations forums :
    Inscription : octobre 2007
    Messages : 3 934
    Points : 6 053
    Points
    6 053
    Par défaut
    Salut
    Une solution parmi tant d'autre
    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
    Option Explicit
    Private Sub btnImportXL_Click()
    On Error GoTo btnImportXL_Err
     
    Dim xlApp As Excel.Application
    Dim xlWbk As Excel.Workbook
    Dim xlWst As Excel.Worksheet
    Dim strFilePath As String, strTableName As String, strSheetName As String
    Dim strImportAddress As String, strImportSheetAddress As String
    Dim shtCount As Long, i 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.xlsx"
    strTableName = "PAT"
     
    Set xlApp = New Excel.Application
    Set xlWbk = xlApp.Workbooks.Open(strFilePath)
     
    shtCount = xlWbk.Worksheets.Count
     
    StartTime = Timer
     
    For i = 1 To shtCount
        Set xlWst = xlWbk.Worksheets(xlWbk.Worksheets(i).Name)
        With xlWst
            lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            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
        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
    "Le savoir est la seule matière qui s'accroit quand on la partage" (Socrate)
    UR - ESIROI - GPME/CG/DCG8
    QTH :21°19'18"S - 055°25'32"E
    Inutile de me contacter par MP
    Si la réponse est satisfaisante, alors 1 et n'oubliez pas de clôturer le sujet en cliquant sur

  4. #4
    Futur Membre du Club
    Homme Profil pro
    impiegato
    Inscrit en
    mai 2019
    Messages
    79
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Italie

    Informations professionnelles :
    Activité : impiegato

    Informations forums :
    Inscription : mai 2019
    Messages : 79
    Points : 7
    Points
    7
    Par défaut
    Bonjour e merci
    Le fichier contient 13 feuilles à importer

  5. #5
    Futur Membre du Club
    Homme Profil pro
    impiegato
    Inscrit en
    mai 2019
    Messages
    79
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Italie

    Informations professionnelles :
    Activité : impiegato

    Informations forums :
    Inscription : mai 2019
    Messages : 79
    Points : 7
    Points
    7
    Par défaut Importer des fichiers Excel avec plusieurs feuilles
    Bonjour et merci pour la réponse
    mais j'obtiens cette erreur en tant que version office j'ai 11 entreprise





    Citation Envoyé par hyperion13 Voir le message
    Salut
    Une solution parmi tant d'autre
    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
    Option Explicit
    Private Sub btnImportXL_Click()
    On Error GoTo btnImportXL_Err
     
    Dim xlApp As Excel.Application
    Dim xlWbk As Excel.Workbook
    Dim xlWst As Excel.Worksheet
    Dim strFilePath As String, strTableName As String, strSheetName As String
    Dim strImportAddress As String, strImportSheetAddress As String
    Dim shtCount As Long, i 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.xlsx"
    strTableName = "PAT"
     
    Set xlApp = New Excel.Application
    Set xlWbk = xlApp.Workbooks.Open(strFilePath)
     
    shtCount = xlWbk.Worksheets.Count
     
    StartTime = Timer
     
    For i = 1 To shtCount
        Set xlWst = xlWbk.Worksheets(xlWbk.Worksheets(i).Name)
        With xlWst
            lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            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
        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
    Images attachées Images attachées

  6. #6
    Expert éminent
    Homme Profil pro
    Webplanneur
    Inscrit en
    octobre 2007
    Messages
    3 934
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 58
    Localisation : France, Ain (Rhône Alpes)

    Informations professionnelles :
    Activité : Webplanneur

    Informations forums :
    Inscription : octobre 2007
    Messages : 3 934
    Points : 6 053
    Points
    6 053
    Par défaut
    Dont use this sub(). The execution time is too long
    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
    Option Explicit
    Private Sub btnImportXL_Click()
    On Error GoTo btnImportXL_Err
     
    Dim xlApp As Excel.Application
    Dim xlWb As Excel.Workbook
    Dim strFilePath As String, strTableName As String, strSheetName As String
    Dim shtCount As Long, i As Long
     
    strFilePath = "C:\Users\Desktop\backup\Nuova cartella\PatInail rev 3.xlsx"
    strTableName = "PAT"
     
    Set xlApp = New Excel.Application
    Set xlWbk = xlApp.Workbooks.Open(strFilePath)
     
    shtCount = xlWbk.Worksheets.Count
     
    For i = 1 To shtCount
        strSheetName = xlWbk.Worksheets(i).Name & "$"
        Debug.Print strSheetName
        DoCmd.TransferSpreadsheet acImport _
            , acSpreadsheetTypeExcel12Xml _
            , strTableName _
            , strFilePath _
            , True _
            , strSheetName
    Next i
     
    btnImportXL_Exit:
        On Error Resume Next
        xlWbk.Close False
        Set xlWbk = Nothing
        xlApp.Quit
        Set xlApp = Nothing
        Exit Sub
    btnImportXL_Err:
        MsgBox Err.Description, , "Erreur " & Err.Number
        Resume btnImportXL_Exit
        Resume
    End Sub
    Use this sub(). The execution time is faster !
    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
    Option Explicit
    Private Sub btnImportXL_Click()
    On Error GoTo btnImportXL_Err
     
    Dim xlApp As Excel.Application
    Dim xlWbk As Excel.Workbook
    Dim xlWst As Excel.Worksheet
    Dim strFilePath As String, strTableName As String, strSheetName As String
    Dim strImportAddress As String, strImportSheetAddress As String
    Dim shtCount As Long, i 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.xlsx"
    strTableName = "PAT"
     
    Set xlApp = New Excel.Application
    Set xlWbk = xlApp.Workbooks.Open(strFilePath)
     
    shtCount = xlWbk.Worksheets.Count
     
    StartTime = Timer
     
    For i = 1 To shtCount
        Set xlWst = xlWbk.Worksheets(xlWbk.Worksheets(i).Name)
        With xlWst
            lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            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
        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
    "Le savoir est la seule matière qui s'accroit quand on la partage" (Socrate)
    UR - ESIROI - GPME/CG/DCG8
    QTH :21°19'18"S - 055°25'32"E
    Inutile de me contacter par MP
    Si la réponse est satisfaisante, alors 1 et n'oubliez pas de clôturer le sujet en cliquant sur

  7. #7
    Rédacteur/Modérateur

    Avatar de User
    Homme Profil pro
    Développeur informatique
    Inscrit en
    août 2004
    Messages
    7 875
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 53
    Localisation : France, Ain (Rhône Alpes)

    Informations professionnelles :
    Activité : Développeur informatique

    Informations forums :
    Inscription : août 2004
    Messages : 7 875
    Points : 18 516
    Points
    18 516
    Billets dans le blog
    38
    Par défaut
    Autant pour moi, j'avais juste oublié le "!" à la fin :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    DoCmd.TransferSpreadsheet acImport, 10, "PAT", "C:\Users\Desktop\backup\Nuova cartella\PatInail rev 3.xlsx", True, strname & "!"
    '...
    Vous trouverez dans la FAQ, les sources ou les tutoriels, de l'information accessible au plus grand nombre, plein de bonnes choses à consulter sans modération

    Des tutoriels pour apprendre à créer des formulaires de planning dans vos applications Access :
    Gestion sur un planning des présences et des absences des employés
    Gestion des rendez-vous sur un calendrier mensuel


    Importer un fichier JSON dans une base de données Access :
    Import Fichier JSON

  8. #8
    Futur Membre du Club
    Homme Profil pro
    impiegato
    Inscrit en
    mai 2019
    Messages
    79
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Italie

    Informations professionnelles :
    Activité : impiegato

    Informations forums :
    Inscription : mai 2019
    Messages : 79
    Points : 7
    Points
    7
    Par défaut
    Merci mais ça me donne toujours la même erreur sur laquelle ça se bloque : Dim xlApp As Excel.Application



    Citation Envoyé par hyperion13 Voir le message
    Dont use this sub(). The execution time is too long
    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
    Option Explicit
    Private Sub btnImportXL_Click()
    On Error GoTo btnImportXL_Err
     
    Dim xlApp As Excel.Application
    Dim xlWb As Excel.Workbook
    Dim strFilePath As String, strTableName As String, strSheetName As String
    Dim shtCount As Long, i As Long
     
    strFilePath = "C:\Users\Desktop\backup\Nuova cartella\PatInail rev 3.xlsx"
    strTableName = "PAT"
     
    Set xlApp = New Excel.Application
    Set xlWbk = xlApp.Workbooks.Open(strFilePath)
     
    shtCount = xlWbk.Worksheets.Count
     
    For i = 1 To shtCount
        strSheetName = xlWbk.Worksheets(i).Name & "$"
        Debug.Print strSheetName
        DoCmd.TransferSpreadsheet acImport _
            , acSpreadsheetTypeExcel12Xml _
            , strTableName _
            , strFilePath _
            , True _
            , strSheetName
    Next i
     
    btnImportXL_Exit:
        On Error Resume Next
        xlWbk.Close False
        Set xlWbk = Nothing
        xlApp.Quit
        Set xlApp = Nothing
        Exit Sub
    btnImportXL_Err:
        MsgBox Err.Description, , "Erreur " & Err.Number
        Resume btnImportXL_Exit
        Resume
    End Sub
    Use this sub(). The execution time is faster !
    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
    Option Explicit
    Private Sub btnImportXL_Click()
    On Error GoTo btnImportXL_Err
     
    Dim xlApp As Excel.Application
    Dim xlWbk As Excel.Workbook
    Dim xlWst As Excel.Worksheet
    Dim strFilePath As String, strTableName As String, strSheetName As String
    Dim strImportAddress As String, strImportSheetAddress As String
    Dim shtCount As Long, i 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.xlsx"
    strTableName = "PAT"
     
    Set xlApp = New Excel.Application
    Set xlWbk = xlApp.Workbooks.Open(strFilePath)
     
    shtCount = xlWbk.Worksheets.Count
     
    StartTime = Timer
     
    For i = 1 To shtCount
        Set xlWst = xlWbk.Worksheets(xlWbk.Worksheets(i).Name)
        With xlWst
            lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            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
        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

  9. #9
    Expert éminent
    Homme Profil pro
    Webplanneur
    Inscrit en
    octobre 2007
    Messages
    3 934
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 58
    Localisation : France, Ain (Rhône Alpes)

    Informations professionnelles :
    Activité : Webplanneur

    Informations forums :
    Inscription : octobre 2007
    Messages : 3 934
    Points : 6 053
    Points
    6 053
    Par défaut
    Activer Microsoft Excel xx.x Object Library
    "Le savoir est la seule matière qui s'accroit quand on la partage" (Socrate)
    UR - ESIROI - GPME/CG/DCG8
    QTH :21°19'18"S - 055°25'32"E
    Inutile de me contacter par MP
    Si la réponse est satisfaisante, alors 1 et n'oubliez pas de clôturer le sujet en cliquant sur

  10. #10
    Futur Membre du Club
    Homme Profil pro
    impiegato
    Inscrit en
    mai 2019
    Messages
    79
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Italie

    Informations professionnelles :
    Activité : impiegato

    Informations forums :
    Inscription : mai 2019
    Messages : 79
    Points : 7
    Points
    7
    Par défaut
    Citation Envoyé par hyperion13 Voir le message
    Activer Microsoft Excel xx.x Object Library
    Oui, j'ai activé
    Microsoft Office 16.0 Object library,Je ne comprends pas pourquoi il plante !!!!
    Images attachées Images attachées

  11. #11
    Expert éminent
    Homme Profil pro
    Webplanneur
    Inscrit en
    octobre 2007
    Messages
    3 934
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 58
    Localisation : France, Ain (Rhône Alpes)

    Informations professionnelles :
    Activité : Webplanneur

    Informations forums :
    Inscription : octobre 2007
    Messages : 3 934
    Points : 6 053
    Points
    6 053
    Par défaut
    il bloque sur quelle ligne et quel est le message d'erreur?
    "Le savoir est la seule matière qui s'accroit quand on la partage" (Socrate)
    UR - ESIROI - GPME/CG/DCG8
    QTH :21°19'18"S - 055°25'32"E
    Inutile de me contacter par MP
    Si la réponse est satisfaisante, alors 1 et n'oubliez pas de clôturer le sujet en cliquant sur

  12. #12
    Rédacteur/Modérateur

    Avatar de User
    Homme Profil pro
    Développeur informatique
    Inscrit en
    août 2004
    Messages
    7 875
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 53
    Localisation : France, Ain (Rhône Alpes)

    Informations professionnelles :
    Activité : Développeur informatique

    Informations forums :
    Inscription : août 2004
    Messages : 7 875
    Points : 18 516
    Points
    18 516
    Billets dans le blog
    38
    Par défaut
    Comme le dit hyperion c'est Microsoft Excel xx.x Object Library qui doit être coché pas Microsoft Office xx.x Object Library
    Vous trouverez dans la FAQ, les sources ou les tutoriels, de l'information accessible au plus grand nombre, plein de bonnes choses à consulter sans modération

    Des tutoriels pour apprendre à créer des formulaires de planning dans vos applications Access :
    Gestion sur un planning des présences et des absences des employés
    Gestion des rendez-vous sur un calendrier mensuel


    Importer un fichier JSON dans une base de données Access :
    Import Fichier JSON

  13. #13
    Futur Membre du Club
    Homme Profil pro
    impiegato
    Inscrit en
    mai 2019
    Messages
    79
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Italie

    Informations professionnelles :
    Activité : impiegato

    Informations forums :
    Inscription : mai 2019
    Messages : 79
    Points : 7
    Points
    7
    Par défaut
    je joins l'erreur
    Images attachées Images attachées

  14. #14
    Membre éclairé
    Profil pro
    Inscrit en
    juillet 2006
    Messages
    448
    Détails du profil
    Informations personnelles :
    Localisation : France, Paris (Île de France)

    Informations forums :
    Inscription : juillet 2006
    Messages : 448
    Points : 718
    Points
    718
    Par défaut
    Histoire de ne pas se faire chier avec les références: Passe en Late Binding.

  15. #15
    Expert éminent
    Homme Profil pro
    Webplanneur
    Inscrit en
    octobre 2007
    Messages
    3 934
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 58
    Localisation : France, Ain (Rhône Alpes)

    Informations professionnelles :
    Activité : Webplanneur

    Informations forums :
    Inscription : octobre 2007
    Messages : 3 934
    Points : 6 053
    Points
    6 053
    Par défaut
    re,
    @deedolith je ne pense pas que cela soit un problème de Late binding ou Early binding.
    Je viens de faire un essai et cela fonctionne sur mon PackOfficePro 2013 32bits.

    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
    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, 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
     
    For i = 1 To shtCount
        Set xlWst = xlWbk.Worksheets(xlWbk.Worksheets(i).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
    "Le savoir est la seule matière qui s'accroit quand on la partage" (Socrate)
    UR - ESIROI - GPME/CG/DCG8
    QTH :21°19'18"S - 055°25'32"E
    Inutile de me contacter par MP
    Si la réponse est satisfaisante, alors 1 et n'oubliez pas de clôturer le sujet en cliquant sur

  16. #16
    Futur Membre du Club
    Homme Profil pro
    impiegato
    Inscrit en
    mai 2019
    Messages
    79
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Italie

    Informations professionnelles :
    Activité : impiegato

    Informations forums :
    Inscription : mai 2019
    Messages : 79
    Points : 7
    Points
    7
    Par défaut
    Bonjour et merci pour votre intérêt.
    1) Je n'importe que la feuille 1, 4400 (le fichier excel comporte plusieurs feuilles)et cela duplique les données
    2)le fichier excel reste ouvert après(je joins le fichier excel)


    Citation Envoyé par hyperion13 Voir le message
    re,
    @deedolith je ne pense pas que cela soit un problème de Late binding ou Early binding.
    Je viens de faire un essai et cela fonctionne sur mon PackOfficePro 2013 32bits.

    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
    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, 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
     
    For i = 1 To shtCount
        Set xlWst = xlWbk.Worksheets(xlWbk.Worksheets(i).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
    Fichiers attachés Fichiers attachés

  17. #17
    Rédacteur/Modérateur

    Avatar de User
    Homme Profil pro
    Développeur informatique
    Inscrit en
    août 2004
    Messages
    7 875
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 53
    Localisation : France, Ain (Rhône Alpes)

    Informations professionnelles :
    Activité : Développeur informatique

    Informations forums :
    Inscription : août 2004
    Messages : 7 875
    Points : 18 516
    Points
    18 516
    Billets dans le blog
    38
    Par défaut
    Attention quand même avec le late binding, car je ne crois pas que cette ligne va passer sans une référence à Excel :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    strImportAddress = WorksheetFunction.Substitute(rngImport.Address, "$", "")
    Il faudrait faire je pense :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    strImportAddress = xlApp.WorksheetFunction.Substitute(rngImport.Address, "$", "")
    Ni d'ailleurs le constantes xlUp et xlToLeft,... qu'il faudrait aussi préfixer.


    Cdlt,
    Vous trouverez dans la FAQ, les sources ou les tutoriels, de l'information accessible au plus grand nombre, plein de bonnes choses à consulter sans modération

    Des tutoriels pour apprendre à créer des formulaires de planning dans vos applications Access :
    Gestion sur un planning des présences et des absences des employés
    Gestion des rendez-vous sur un calendrier mensuel


    Importer un fichier JSON dans une base de données Access :
    Import Fichier JSON

  18. #18
    Expert éminent
    Homme Profil pro
    Webplanneur
    Inscrit en
    octobre 2007
    Messages
    3 934
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 58
    Localisation : France, Ain (Rhône Alpes)

    Informations professionnelles :
    Activité : Webplanneur

    Informations forums :
    Inscription : octobre 2007
    Messages : 3 934
    Points : 6 053
    Points
    6 053
    Par défaut
    @lourid
    Désolé avec votre fichier la sub() du Post#15 fonctionne très bien et fait le job.
    Votre table est-elle correctement structurée et vos champs ont-ils le bon type de données ?

    User@
    Salut,
    Que j'utilise Late ou Early binding, j'active toujours Microsoft Excel xx.x Object Library.
    Images attachées Images attachées  
    Fichiers attachés Fichiers attachés
    "Le savoir est la seule matière qui s'accroit quand on la partage" (Socrate)
    UR - ESIROI - GPME/CG/DCG8
    QTH :21°19'18"S - 055°25'32"E
    Inutile de me contacter par MP
    Si la réponse est satisfaisante, alors 1 et n'oubliez pas de clôturer le sujet en cliquant sur

  19. #19
    Futur Membre du Club
    Homme Profil pro
    impiegato
    Inscrit en
    mai 2019
    Messages
    79
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Italie

    Informations professionnelles :
    Activité : impiegato

    Informations forums :
    Inscription : mai 2019
    Messages : 79
    Points : 7
    Points
    7
    Par défaut
    Salut
    peut-être que je ne peux pas expliquer
    mais je dois importer toutes les feuilles du fichier xlsx

    Citation Envoyé par hyperion13 Voir le message
    @lourid
    Désolé avec votre fichier la sub() du Post#15 fonctionne très bien et fait le job.
    Votre table est-elle correctement structurée et vos champs ont-ils le bon type de données ?

    User@
    Salut,
    Que j'utilise Late ou Early binding, j'active toujours Microsoft Excel xx.x Object Library.

  20. #20
    Expert éminent
    Homme Profil pro
    Webplanneur
    Inscrit en
    octobre 2007
    Messages
    3 934
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 58
    Localisation : France, Ain (Rhône Alpes)

    Informations professionnelles :
    Activité : Webplanneur

    Informations forums :
    Inscription : octobre 2007
    Messages : 3 934
    Points : 6 053
    Points
    6 053
    Par défaut
    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) !
    Images attachées Images attachées  
    "Le savoir est la seule matière qui s'accroit quand on la partage" (Socrate)
    UR - ESIROI - GPME/CG/DCG8
    QTH :21°19'18"S - 055°25'32"E
    Inutile de me contacter par MP
    Si la réponse est satisfaisante, alors 1 et n'oubliez pas de clôturer le sujet en cliquant sur

+ Répondre à la discussion
Cette discussion est résolue.
Page 1 sur 2 12 DernièreDernière

Discussions similaires

  1. Comment générer un fichier Excel avec plusieurs feuilles ?
    Par sinoun dans le forum Développement de jobs
    Réponses: 4
    Dernier message: 15/03/2018, 16h16
  2. [POI] Importer fichier Excel avec plusieurs feuilles
    Par ninoch07 dans le forum Documents
    Réponses: 9
    Dernier message: 10/02/2015, 10h59
  3. importation des fichiers excel avec jee
    Par soon13 dans le forum Développement
    Réponses: 1
    Dernier message: 10/01/2011, 18h07
  4. Créer un fichier excel avec plusieurs feuilles à partir d'un fichier html
    Par yuukuari dans le forum Balisage (X)HTML et validation W3C
    Réponses: 2
    Dernier message: 07/12/2009, 17h07
  5. Réponses: 4
    Dernier message: 12/05/2009, 13h21

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo