Traitement des lignes s'arrête à la ligne 512

Bonjour,

J'ai une macro qui retranscrit sous format txt un listing de commande Excel de la feuille (COMMANDE)

La macro génère des codes pour chaque articles du tableau.

Le problème est que j'ai remarqué que le traitement s'arrête à la ligne 512.

Auriez-vous une idée du problème ?

Merci à tous,

Bonne journée

Loadlucas

Voici la macro :

Sub Save_as_txt()

Dim fs
Dim Chemin As String
Dim DerniereLigne As Long
Dim Tableau() As Variant
Dim Ligne As Long
Dim zero
Dim I
Dim code_mag As String
Dim code_mag_full_len As String
Dim nom_mag As String
date_test = Now()

    With ThisWorkbook.Worksheets("COMMANDE")
        DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    If DerniereLigne = 0 Then Exit Sub
    Chemin = Application.ActiveWorkbook.Path

    Ligne = 1

        code_mag = ActiveSheet.Range("B1")
        If Len(code_mag) = 7 Then code_mag_full_len = "0" & code_mag Else code_mag_full_len = ActiveSheet.Range("B1")
        nom_mag = ActiveSheet.Range("A1")

    Do While Ligne <= DerniereLigne
        ReDim Preserve Tableau(Ligne)

        If Ligne = 1 Then
        Tableau(Ligne) = "I99" & Format(date_test, "dmmyy")

        ElseIf Ligne = 2 Then
            Tableau(Ligne) = "H" & code_mag_full_len & "2"
        Else
            If Len(Range("A" & Ligne).Value) = 2 Then Tableau(Ligne) = "D0000" & Range("A" & Ligne).Value
            If Len(Range("A" & Ligne).Value) = 3 Then Tableau(Ligne) = "D000" & Range("A" & Ligne).Value
            If Len(Range("A" & Ligne).Value) = 4 Then Tableau(Ligne) = "D00" & Range("A" & Ligne).Value
            If Len(Range("A" & Ligne).Value) = 5 Then Tableau(Ligne) = "D0" & Range("A" & Ligne).Value
            If Len(Range("A" & Ligne).Value) = 6 Then Tableau(Ligne) = "D" & Range("A" & Ligne).Value

            If Len(Range("A" & Ligne).Value) = 2 Then zero = 12 - Len(Range("A" & Ligne).Value) - Len(Range("c" & Ligne).Value)
            If Len(Range("A" & Ligne).Value) = 3 Then zero = 13 - Len(Range("A" & Ligne).Value) - Len(Range("c" & Ligne).Value)
            If Len(Range("A" & Ligne).Value) = 4 Then zero = 14 - Len(Range("A" & Ligne).Value) - Len(Range("c" & Ligne).Value)
            If Len(Range("A" & Ligne).Value) = 5 Then zero = 15 - Len(Range("A" & Ligne).Value) - Len(Range("c" & Ligne).Value)
            If Len(Range("A" & Ligne).Value) = 6 Then zero = 16 - Len(Range("A" & Ligne).Value) - Len(Range("c" & Ligne).Value)
            For I = 1 To zero
                Tableau(Ligne) = Tableau(Ligne) & "0"
            Next I
            Tableau(Ligne) = Tableau(Ligne) & Range("c" & Ligne).Value
        End If
        Ligne = Ligne + 1
    Loop

    On Error GoTo GestionErreur
    Kill Chemin & "/" & "Magasin" & " " & nom_mag & " " & code_mag & " Com Food" & " " & Format(date_test, "dmmyy") & ".txt"

    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.CreateTextFile Chemin & "/" & "Magasin" & " " & nom_mag & " " & code_mag & " Com Food" & " " & Format(date_test, "dmmyy") & ".txt"
    GoTo pp
GestionErreur:
    A = Err.Number
    Select Case Err.Number
    Case 53
        Set fs = CreateObject("Scripting.FileSystemObject")
        fs.CreateTextFile Chemin & "/" & "Magasin" & " " & nom_mag & " " & code_mag & " Com Food" & " " & Format(date_test, "dmmyy") & ".txt"
    End Select
    On Error GoTo 0
pp:
    Ligne = 1
    Do While Ligne <= DerniereLigne
        Open Chemin & "/" & "Magasin" & " " & nom_mag & " " & code_mag & " Com Food" & " " & Format(date_test, "dmmyy") & ".txt" For Append As #Ligne
        Print #Ligne, Tableau(Ligne)
        Close
        Ligne = Ligne + 1
    Loop
    On Error Resume Next
    With CreateObject("WScript.Shell")
        .Run ("Notepad.exe " & Chemin & "/" & "Magasin" & " " & nom_mag & " " & code_mag & " Com Food" & " " & Format(date_test, "dmmyy") & ".txt")
    End With

End Sub

bonjour,

sans fichier et ne regardant que le code, c'est probablement parce que la dernière cellule non vide en colonne A est est en ligne 512

Bonjour

Merci pour votre réponse mais non ... toutes les colonnes ont une valeur.

Je vous poste le fichier avec la macro

Encore merci,

Loadlucas

12testcommande.xlsm (32.91 Ko)

bonjour,

utliise cette instruction

        Open Chemin & "\" & "Magasin" & " " & nom_mag & " " & code_mag & " Com Food" & " " & Format(date_test, "dmmyy") & ".txt" For Append As #1

au lieu de

        Open Chemin & "\" & "Magasin" & " " & nom_mag & " " & code_mag & " Com Food" & " " & Format(date_test, "dmmyy") & ".txt" For Append As #ligne

Bonjour,

Plus d'erreur ... mais le fichier txt est vide

re-bonjour,

il faut également changer l'instruction print

   Print #1, Tableau(Ligne)

Parfait !

Un tout grand merci !

Bonne journée

Loadlucas

Juste par curiosité ... et pourquoi cela ne fonctionnait que "partiellement" ?

Encore merci

Loadlucas

bonjour,

pour travailler avec des fichiers, VBA utilise des canaux, le canal est défini à l'ouverture du fichier et est utilisé par la suite pour indique le fichier auquel vont se rapporter les instructions de lecture/écriture dans le fichier.

par exemple :

ouvrir fichier "A" et lui associer le canal 1, open "A" as #1

ouvrir le fichier "B" et lui associer le canal 2, open "B" as #2

ecrire dans 1 et écrire dans 2, print #1 et print#2

fermer 1 et fermer 2, close 1,2

le nombre de canaux est limité à 512.

ton code ouvre 512 fois le fichier en mode ajout, ajoute une ligne puis se plante au moment d'essayer d'ouvrir le fichier sur le canal 513.

il conviendrait d'ailleurs de réécrire ce code

Ligne = 1
        Open Chemin & "/" & "Magasin" & " " & nom_mag & " " & code_mag & " Com Food" & " " & Format(date_test, "dmmyy") & ".txt" For Append As #1
    Do While Ligne <= DerniereLigne
        Print #1, Tableau(Ligne)
        Ligne = Ligne + 1
    Loop
close 1

OK ! ...
Merci pour les explications !

Bonne journée

Loadlucas

Rechercher des sujets similaires à "traitement lignes arrete ligne 512"