VBA - Code qui ne fonctionne pas - Erreur : 1004

Le 15/04/2023 à 17:43

Bonjour,

je me permets de vous demander de l'aide pour connaitre pourquoi le code suivant ne fonctionne pas

Function ExtractNameFromPath(ByVal Path As String) As String
'Extraire le nom du fichier à partir du chemin d'accès
ExtractNameFromPath = Right(Path, Len(Path) - InStrRev(Path, "\"))
End Function
Sub OpenTxtFiles()

'Déclaration des variables
Dim Chemin As Range
Dim CheminCell As Range
Dim P1 As Worksheet, P2 As Worksheet, P3 As Worksheet, P4 As Worksheet, P5 As Worksheet
Dim PENA1 As Worksheet, PENA2 As Worksheet, PENA3 As Worksheet, PENA4 As Worksheet, PENA5 As Worksheet
Dim VIE As Worksheet, RSI As Worksheet

'Définition des onglets correspondants
Set P1 = ThisWorkbook.Sheets("Feuil1")
Set P2 = ThisWorkbook.Sheets("Feuil2")
Set P3 = ThisWorkbook.Sheets("Feuil3")
Set P4 = ThisWorkbook.Sheets("Feuil4")
Set P5 = ThisWorkbook.Sheets("Feuil5")
Set PENA1 = ThisWorkbook.Sheets("Feuil6")
Set PENA2 = ThisWorkbook.Sheets("Feuil7")
Set PENA3 = ThisWorkbook.Sheets("Feuil8")
Set PENA4 = ThisWorkbook.Sheets("Feuil9")
Set PENA5 = ThisWorkbook.Sheets("Feuil10")
Set VIE = ThisWorkbook.Sheets("Feuil11")
Set RSI = ThisWorkbook.Sheets("Feuil12")

'Définition de la plage contenant les chemins des fichiers texte
Set Chemin = ThisWorkbook.Sheets("chemin").Range("A1:A" & ThisWorkbook.Sheets("chemin").Cells(Rows.Count, "A").End(xlUp).Row)

'Boucle pour ouvrir chaque fichier et le copier dans un onglet correspondant
For Each CheminCell In Chemin
If CheminCell.Value <> "" Then
'Définition de l'onglet correspondant en fonction du nom du chemin
Select Case True
Case InStr(1, CheminCell.Value, "P1") > 0
Set Feuille = P1
Case InStr(1, CheminCell.Value, "P2") > 0
Set Feuille = P2
Case InStr(1, CheminCell.Value, "P3") > 0
Set Feuille = P3
Case InStr(1, CheminCell.Value, "P4") > 0
Set Feuille = P4
Case InStr(1, CheminCell.Value, "P5") > 0
Set Feuille = P5
Case InStr(1, CheminCell.Value, "PENA1") > 0
Set Feuille = PENA1
Case InStr(1, CheminCell.Value, "PENA2") > 0
Set Feuille = PENA2
Case InStr(1, CheminCell.Value, "PENA3") > 0
Set Feuille = PENA3
Case InStr(1, CheminCell.Value, "PENA4") > 0
Set Feuille = PENA4
Case InStr(1, CheminCell.Value, "PENA5") > 0
Set Feuille = PENA5
Case InStr(1, CheminCell.Value, "VIE") > 0
Set Feuille = VIE
Case InStr(1, CheminCell.Value, "RSI") > 0
Set Feuille = RSI
End Select

'Ouverture du fichier texte
With Feuille.QueryTables.Add(Connection:="TEXT;" & CheminCell.Value, Destination:=Feuille.Range("A1"))
.Name = "Import_" & Feuille.Name
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

'Renommer l'onglet avec le nom correspondant
Feuille.Name = ExtractNameFromPath(CheminCell.Value)
End If
Next CheminCell

End Sub

Merci de votre aide si vous pouvez.

Je reste a disposition pour plus de détails ou d'informations

Le 15/04/2023 à 18:17

bonjour,

Qu'est-ce qui ne fonctionne pas ? Tu reçois un message d'erreur ? Les fichiers ne sont pas lus ? les feuilles ne sont pas renommées ?

De plus, peux-tu mettre un extrait de ton fichier avec quelques données sur la feuille chemin permettant d'en comprendre sa structure et comment les données sont introduites en colonne A?

Enfin merci de mettre ton code entre balises "code" (bouton </>)

Le 16/04/2023 à 00:54
capture d ecran 2023 04 16 a 00 50 07
Le 16/04/2023 à 00:56
capture d ecran 2023 04 16 a 00 50 55
Le 16/04/2023 à 01:04
Le 16/04/2023 à 01:08
capture d ecran 2023 04 16 a 01 02 57
Le 16/04/2023 à 01:10

c'est le message d'erreur que j'ai .

je ne sais pas est ce que je sui claire en envoyant le nom du dossier, la feuille excel, les fichiers a ouvrir ( Variable chaque fois , c'est entre 1 et 12 )

Merci

Le 16/04/2023 à 01:11
Function ExtractNameFromPath(ByVal Path As String) As String
    'Extraire le nom du fichier à partir du chemin d'accès
    ExtractNameFromPath = Right(Path, Len(Path) - InStrRev(Path, "\"))
End Function
    Sub OpenTxtFiles()

    'Déclaration des variables
    Dim Chemin As Range
    Dim CheminCell As Range
    Dim P1 As Worksheet, P2 As Worksheet, P3 As Worksheet, P4 As Worksheet, P5 As Worksheet
    Dim PENA1 As Worksheet, PENA2 As Worksheet, PENA3 As Worksheet, PENA4 As Worksheet, PENA5 As Worksheet
    Dim VIE As Worksheet, RSI As Worksheet

    'Définition des onglets correspondants
    Set P1 = ThisWorkbook.Sheets("Feuil1")
    Set P2 = ThisWorkbook.Sheets("Feuil2")
    Set P3 = ThisWorkbook.Sheets("Feuil3")
    Set P4 = ThisWorkbook.Sheets("Feuil4")
    Set P5 = ThisWorkbook.Sheets("Feuil5")
    Set PENA1 = ThisWorkbook.Sheets("Feuil6")
    Set PENA2 = ThisWorkbook.Sheets("Feuil7")
    Set PENA3 = ThisWorkbook.Sheets("Feuil8")
    Set PENA4 = ThisWorkbook.Sheets("Feuil9")
    Set PENA5 = ThisWorkbook.Sheets("Feuil10")
    Set VIE = ThisWorkbook.Sheets("Feuil11")
    Set RSI = ThisWorkbook.Sheets("Feuil12")

    'Définition de la plage contenant les chemins des fichiers texte
    Set Chemin = ThisWorkbook.Sheets("chemin").Range("A1:A" & ThisWorkbook.Sheets("chemin").Cells(Rows.Count, "A").End(xlUp).Row)

    'Boucle pour ouvrir chaque fichier et le copier dans un onglet correspondant
    For Each CheminCell In Chemin
        If CheminCell.Value <> "" Then
            'Définition de l'onglet correspondant en fonction du nom du chemin
            Select Case True
                Case InStr(1, CheminCell.Value, "P1") > 0
                    Set Feuille = P1
                Case InStr(1, CheminCell.Value, "P2") > 0
                    Set Feuille = P2
                Case InStr(1, CheminCell.Value, "P3") > 0
                    Set Feuille = P3
                Case InStr(1, CheminCell.Value, "P4") > 0
                    Set Feuille = P4
                Case InStr(1, CheminCell.Value, "P5") > 0
                    Set Feuille = P5
                Case InStr(1, CheminCell.Value, "PENA1") > 0
                    Set Feuille = PENA1
                Case InStr(1, CheminCell.Value, "PENA2") > 0
                    Set Feuille = PENA2
                Case InStr(1, CheminCell.Value, "PENA3") > 0
                    Set Feuille = PENA3
                Case InStr(1, CheminCell.Value, "PENA4") > 0
                    Set Feuille = PENA4
                Case InStr(1, CheminCell.Value, "PENA5") > 0
                    Set Feuille = PENA5
                Case InStr(1, CheminCell.Value, "VIE") > 0
                    Set Feuille = VIE
                            Case InStr(1, CheminCell.Value, "RSI") > 0
                Set Feuille = RSI
        End Select

        'Ouverture du fichier texte
        With Feuille.QueryTables.Add(Connection:="TEXT;" & CheminCell.Value, Destination:=Feuille.Range("A1"))
            .Name = "Import_" & Feuille.Name
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With

        'Renommer l'onglet avec le nom correspondant
        Feuille.Name = ExtractNameFromPath(CheminCell.Value)
    End If
Next CheminCell

End Sub
Le 16/04/2023 à 07:36

Bonjour le fil

Edit : Je vous invite à lire la charte du forum [A LIRE AVANT DE POSTER] et notamment :

  • Ne postez pas la même question sur un autre forum pour éviter de faire perdre bêtement du temps aux membres sur un problème qui peut être déjà résolu sur l'autre forum. L'inverse est également valable, si vous avez déjà posé votre question sur un autre forum, ne créez pas un doublon sur ce forum (à moins d'avoir clôturé le sujet sur l'autre forum).

Je clôture donc le post ici en attendant votre décision

Merci de votre compréhension et de votre participation

Rechercher des sujets similaires à "vba code qui fonctionne pas erreur 1004"