Boucle importation CSV

Le 12/01/2022 à 22:27

Bonjour à tous,

Je suis en train de créer un planning qui s'exporte en fichier txt (CSV) et s'importe.

Tout fonctionne correctement pour le tableau de base, par contre j'ai des valeurs qui sortent de ce tableau que j'aimerais incrémenter dans le fichier txt d'enregistrement et aussi de le réimporter.

Par exemple la valeur de la cellule qui contient l'année et le numéro de semaine.

image

Je ne sais pas comment forcer lors de l'importation du fichier texte de lui dire qu'a la première ligne du fichier texte:
"2022";"09";"TITRERAJOUT1";"TITRERAJOUT2";"TITRERAJOUT3" sont à mettre dans certaines cellules.

Voici mon code :

Dim ligne_debut As Integer: Dim colonne_debut As Integer
Dim ligne_fin As Integer: Dim colonne_fin As Integer
Dim ligne_enCours As Integer: Dim colonne_enCours As Integer

Private Sub cmdImportCsv_Click()
Dim fichier_choisi As String
Dim nom_fichier As String

'ChDrive ThisWorkbook.Path
'ChDir ThisWorkbook.Path & "\Data\HEBDO_CSV"
fichier_choisi = Application.GetOpenFilename("Fichier Texte (*.txt), *.txt", , "Sélectionner le planning (*.txt)")

If (LCase(fichier_choisi) = "faux" Or fichier_choisi = "0") Then
    Exit Sub
End If

'EXPORTER

ligne_debut = 3: colonne_debut = 3
ligne_enCours = ligne_debut: colonne_enCours = colonne_debut

' On supprime les données
ThisWorkbook.Sheets("HEBDO").Range("C3:I51").ClearContents
ThisWorkbook.Sheets("HEBDO").Range("C54:I91").ClearContents

lectureCSV (fichier_choisi)

End Sub

Private Sub lectureCSV(fichier As String)
Dim depart As Integer, position As Integer
Dim texte As String, tampon As String

Open fichier For Input As #1

Do While Not EOF(1)

    Line Input #1, texte
    depart = 1: position = 1
    Do While (position <> 0)

        position = InStr(depart, texte, ";", 1)
        If position = 0 Then
            tampon = Mid(texte, depart)
            ThisWorkbook.Sheets("HEBDO").Cells(ligne_enCours, colonne_enCours).Value = tampon
            Exit Do
        Else
            tampon = Mid(texte, depart, position - depart)
        End If

            If ligne_enCours = 41 Then
            ligne_enCours = 42
            ElseIf ligne_enCours = 45 Then
            ligne_enCours = 46
            ElseIf ligne_enCours = 48 Then
            ligne_enCours = 49
            ElseIf ligne_enCours = 52 Then
            ligne_enCours = 54
            End If

        ThisWorkbook.Sheets("HEBDO").Cells(ligne_enCours, colonne_enCours).Value = tampon
        depart = position + 1
        colonne_enCours = colonne_enCours + 1
    Loop

    colonne_enCours = colonne_debut
    ligne_enCours = ligne_enCours + 1

Loop

Close #1

End Sub

Private Sub ecritureCSV()

Dim ligne As Integer, colonne As Integer
Dim texte As String, sem As String, datefichier As String, mois As String, cheminfichier As String

'Les variables pour le nom du fichier
datefichier = ThisWorkbook.Sheets("HEBDO").Cells(4, "L").Value

If ThisWorkbook.Sheets("HEBDO").Cells(6, "L").Value < 10 Then
sem = "S" & Format(ThisWorkbook.Sheets("HEBDO").Cells(6, "L").Value, "0#")
Else
sem = "S" & ThisWorkbook.Sheets("HEBDO").Cells(6, "L").Value
End If

mois = ThisWorkbook.Sheets("HEBDO").Cells(8, "L").Value

nom_fichier = datefichier & "_" & sem & "_" & mois & ".txt"

cheminfichier = ThisWorkbook.Path & "\" '& "\Data\HEBDO_CSV\"

'TEST CREATION FICHIER
If FichierExiste(cheminfichier & nom_fichier) = True Then
    If MsgBox("Un fichier existe déjà pour cette semaine, voulez vous le mettre à jour ?", vbYesNo + vbInformation, "Informations") = vbNo Then
    Exit Sub
    End If
End If

'On initialise les variables

ligne_debut = 3: colonne_debut = 3
ligne_enCours = ligne_debut: colonne_enCours = colonne_debut
ligne_fin = 91: colonne_fin = 9

ligne = ligne_debut: colonne = colonne_debut

'On créait le fichier et on le remplie
Open cheminfichier & nom_fichier For Output As #1

    Do While ligne <= ligne_fin

    If ligne = 41 Then
    ligne = 42
    ElseIf ligne = 45 Then
    ligne = 46
    ElseIf ligne = 48 Then
    ligne = 49
    ElseIf ligne = 52 Then
    ligne = 54
    End If

        Do While colonne <= colonne_fin
        texte = texte & Cells(ligne, colonne).Value & ";"
        colonne = colonne + 1
        Loop

    Print #1, texte
    texte = ""
    colonne = colonne_debut
    ligne = ligne + 1

    Loop

Close #1

End Sub

Je vous joints les fichiers :

- le fichier xlsm
- le fichier txt comme exemple (qui sert à l'importation), l'enregistrement fonctionne aussi.

5test-1.xlsm (50.40 Ko)
32022-s09-mars.txt (1.61 Ko)

Merci d'avance pour l'aide apportée ! :)

Le 12/01/2022 à 23:39

Re-bonsoir,

Avec de l'archanement on y arrive !

Dim ligne_debut As Integer: Dim colonne_debut As Integer
Dim ligne_fin As Integer: Dim colonne_fin As Integer
Dim ligne_enCours As Integer: Dim colonne_enCours As Integer

Private Sub cmdImportCsv_Click()
Dim fichier_choisi As String
Dim nom_fichier As String

'ChDrive ThisWorkbook.Path
'ChDir ThisWorkbook.Path & "\Data\HEBDO_CSV"
fichier_choisi = Application.GetOpenFilename("Fichier Texte (*.txt), *.txt", , "Sélectionner le planning (*.txt)")

If (LCase(fichier_choisi) = "faux" Or fichier_choisi = "0") Then
    Exit Sub
End If

'EXPORTER

ligne_debut = 2: colonne_debut = 3
ligne_enCours = ligne_debut: colonne_enCours = colonne_debut

' On supprime les données
ThisWorkbook.Sheets("HEBDO").Range("C3:I51").ClearContents
ThisWorkbook.Sheets("HEBDO").Range("C54:I91").ClearContents

lectureCSV (fichier_choisi)

End Sub

Private Sub lectureCSV(fichier As String)
Dim depart As Integer, position As Integer
Dim texte As String, tampon As String

Open fichier For Input As #1

Do While Not EOF(1)

    Line Input #1, texte
    depart = 1: position = 1
    Do While (position <> 0)

        position = InStr(depart, texte, ";", 1)

        If position = 0 Then
            tampon = Mid(texte, depart)
            ThisWorkbook.Sheets("HEBDO").Cells(ligne_enCours, colonne_enCours).Value = tampon
            Exit Do
        Else
            tampon = Mid(texte, depart, position - depart)
        End If

            If ligne_enCours = 41 Then
            ligne_enCours = 42
            ElseIf ligne_enCours = 45 Then
            ligne_enCours = 46
            ElseIf ligne_enCours = 48 Then
            ligne_enCours = 49
            ElseIf ligne_enCours = 52 Then
            ligne_enCours = 54
            End If

        If tampon Like "L4ANNEE*" Then
        ThisWorkbook.Sheets("HEBDO").Cells(4, "L").Value = Replace(tampon, "L4ANNEE", "")
        ElseIf tampon Like "L6SEM*" Then
        ThisWorkbook.Sheets("HEBDO").Cells(6, "L").Value = Replace(tampon, "L6SEM", "")
        ElseIf tampon Like "K49TITRE*" Then
        ThisWorkbook.Sheets("HEBDO").Cells(49, "K").Value = Replace(tampon, "K49TITRE", "")
        ElseIf tampon Like "K50TITRE*" Then
        ThisWorkbook.Sheets("HEBDO").Cells(50, "K").Value = Replace(tampon, "K50TITRE", "")
        ElseIf tampon Like "K51TITRE*" Then
        ThisWorkbook.Sheets("HEBDO").Cells(51, "K").Value = Replace(tampon, "K51TITRE", "")
        Else
        ThisWorkbook.Sheets("HEBDO").Cells(ligne_enCours, colonne_enCours).Value = tampon
        End If

        depart = position + 1
        colonne_enCours = colonne_enCours + 1
    Loop

    colonne_enCours = colonne_debut
    ligne_enCours = ligne_enCours + 1

Loop

Close #1

End Sub

Private Sub ecritureCSV()

Dim ligne As Integer, colonne As Integer
Dim texte As String, semS As String, sem As String, datefichier As String, mois As String, cheminfichier As String
Dim titreR1 As String, titreR2 As String, titreR3 As String

'Les variables pour le nom du fichier
datefichier = ThisWorkbook.Sheets("HEBDO").Cells(4, "L").Value

If ThisWorkbook.Sheets("HEBDO").Cells(6, "L").Value < 10 Then
semS = "S" & Format(ThisWorkbook.Sheets("HEBDO").Cells(6, "L").Value, "0#")
Else
semS = "S" & ThisWorkbook.Sheets("HEBDO").Cells(6, "L").Value
End If

mois = ThisWorkbook.Sheets("HEBDO").Cells(8, "L").Value

nom_fichier = datefichier & "_" & semS & "_" & mois & ".txt"

cheminfichier = ThisWorkbook.Path & "\" '& "\Data\HEBDO_CSV\"

'TEST CREATION FICHIER
If FichierExiste(cheminfichier & nom_fichier) = True Then
    If MsgBox("Un fichier existe déjà pour cette semaine, voulez vous le mettre à jour ?", vbYesNo + vbInformation, "Informations") = vbNo Then
    Exit Sub
    End If
End If

'On initialise les variables

ligne_debut = 3: colonne_debut = 3
ligne_enCours = ligne_debut: colonne_enCours = colonne_debut
ligne_fin = 91: colonne_fin = 9

ligne = ligne_debut: colonne = colonne_debut

'Variable ANNEE/SEMAINE/TITRERAJOUTS
ann = "L4ANNEE" & ThisWorkbook.Sheets("HEBDO").Cells(4, "l").Value
sem = "L6SEM" & Format(ThisWorkbook.Sheets("HEBDO").Cells(6, "L").Value, "0#")
titreR1 = "K49TITRE" & ThisWorkbook.Sheets("HEBDO").Cells(49, "K").Value
titreR2 = "K50TITRE" & ThisWorkbook.Sheets("HEBDO").Cells(50, "K").Value
titreR3 = "K51TITRE" & ThisWorkbook.Sheets("HEBDO").Cells(51, "K").Value

'On créait le fichier et on le remplie
Open cheminfichier & nom_fichier For Output As #1

Print #1, ann & ";" & sem & ";" & titreR1 & ";" & titreR2 & ";" & titreR3 & ";"

    Do While ligne + 1 <= ligne_fin + 1

    If ligne = 41 Then
    ligne = 42
    ElseIf ligne = 45 Then
    ligne = 46
    ElseIf ligne = 48 Then
    ligne = 49
    ElseIf ligne = 52 Then
    ligne = 54
    End If

        Do While colonne <= colonne_fin
        texte = texte & Cells(ligne, colonne).Value & ";"
        colonne = colonne + 1
        Loop

    Print #1, texte
    texte = ""
    colonne = colonne_debut
    ligne = ligne + 1

    Loop

Close #1

End Sub

Bonne soirée !

Rechercher des sujets similaires à "boucle importation csv"