ERREUR l'entrée dépasse la fin du fichier

khawla.az Messages postés 14 Date d'inscription   Statut Membre Dernière intervention   -  
Kalissi Messages postés 218 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour, Ce macro permet d'importer un fichier csv dans une feuille mais il y a une erreur qui j'arrive pas à la résoudre. c'est l'entrée dépasse la fin du fichier au niveau de cette ligne "laChaine = Input(LOF(x), #x)".

Sub ImportCSV()
 Application.ScreenUpdating = False
    Dim laChaine As String, x, fichier As String, texte, i As Long, sh As Long, lig As Long 'variable necessaire
    Dim J As Long
    Dim l As Integer
    Dim k As Integer
    Dim DerCol As Integer
    Dim f1 As Worksheet
    Dim p As Integer
    Dim LeNom As String
    Dim sht As Worksheet
    Dim Mois As String
    
    Application.ScreenUpdating = False

   
    ' partie 1
   ' ouverture de la boite de dialog fichier
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False ' on choisi q'un seul fichier
        If .Show = True Then 'si on annule pas
            fichier = .SelectedItems(1) 'fichier sera l'item choisi dans la boite de dialog
            LeNom = Mid(fichier, InStrRev(fichier, "\") + 1)  ' extraction du nom par ric
            LeNom = Left(LeNom, (Len(LeNom) - 4))
        Else
            MsgBox "Annuler" ' sinon un message
            Exit Sub 'sortie de sub si annuler
        End If
    End With
    'partie 2
    ' lecture et enregistrement du csv dans la variable
    x = FreeFile
    Open fichier For Input As #x  'ouverture du fichier en mémoire(non apparent)
    laChaine = Input(LOF(x), #x) 'placement du texte complet dans la variable "lachaine"
    Close #x ' fermeture du fichier
    'partie 3
    'exploitation du csv
    sh = 2   ' on demarre au 2 eme sheets le premier étant l'accueil chez moi
    texte = Split(laChaine, vbCrLf)  ' on coupe le texte par les saut de ligne
    For i = 0 To UBound(texte)
        lig = lig + 1    'on increment le n° de ligne
        With Sheets(sh)
               .Name = LeNom  ' on nomme le sheets
            .Cells(lig, 1) = texte(i)    'on met la ligne entiere dansla cellule la ligne complete meme avec  les pointvirgules
            If lig = Rows.Count - 2 Or i = UBound(texte) Then    ' si on arrive en bas du sheets ou au bout des lignes du csv alors
                'on applique la fonction native |||textTocolumns||| par les point virgules
                .Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False
                'DataType:=OtherChar, OtherChar:=";",TextQualifier:=xlDoubleQuote, Space:=True
                sh = sh + 1: lig = 0 'on increment l'index de sheets

                If Sheets.Count < sh Then Sheets.Add After:=Sheets(Sheets.Count) 'au cas ou il n'y aurait pas le sheets (sh) on l'ajoute
            End If
        End With
    Next
sub end 


Ajout de la coloration
A voir également:

2 réponses

f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour,

Marche tres bien!!!!!!!!!!!
Maintenant vous pouvez faire un import via le menu Donnees et tout a gauche choix du type de fichier avec l'enregistreur de macro et faire les modifs pour cadrer avec votre choix de fichier dans le code
0
Kalissi Messages postés 218 Date d'inscription   Statut Membre Dernière intervention   20
 
Bonjour,

Si f894009 a bien réussi à faire fonctionner cette macro ...

L'exécution à répétition de la partie 2 (ouverture du fichier) peut corrompre le fichier
si le close n'est pas bien fait entre chaque. Il serait souhaitable de valider le fichier ...
(ex. : l'ouvrir avec Excel et le réenregistrer ...)

De plus je recommande de vérifier le contenu de la chaine avant de la manipuler ;

    If Not (laChaine Is Nothing) Then
        texte = Split(laChaine, vbCrLf)  ' on coupe le texte par les saut de ligne
        ' ... suite
    End If


Avant de manipuler un objet il est toujours souhaitable de vérifier que celui ci est bien vivant :-)

K
0