IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Voir le flux RSS

tototiti2008

Codes VBA Excel pour créer, lire ou ajouter des données à un fichier texte

Noter ce billet
par , 09/10/2024 à 14h13 (381 Affichages)
Bonjour,

Ci-dessous un lien vers un fichier faisant démonstration de différentes méthode de création, lecture et ajout de données dans des fichiers texte en VBA Excel
Ce que ça implique en terme d'encodage de fichier (ANSI, UTF-8 ou UTF-16) et en terme de séparateur de ligne (CR, LF, CRLF)
Si vous en connaissez d'autres, je suis intéressé
J'avoue que la méthode ADODB.Stream reste un peu cryptique pour moi, sortant un peu de la logique "fichier" à laquelle je suis plus habitué

https://excel.developpez.com/telecha...-fichier-texte

Envoyer le billet « Codes VBA Excel pour créer, lire ou ajouter des données à un fichier texte » dans le blog Viadeo Envoyer le billet « Codes VBA Excel pour créer, lire ou ajouter des données à un fichier texte » dans le blog Twitter Envoyer le billet « Codes VBA Excel pour créer, lire ou ajouter des données à un fichier texte » dans le blog Google Envoyer le billet « Codes VBA Excel pour créer, lire ou ajouter des données à un fichier texte » dans le blog Facebook Envoyer le billet « Codes VBA Excel pour créer, lire ou ajouter des données à un fichier texte » dans le blog Digg Envoyer le billet « Codes VBA Excel pour créer, lire ou ajouter des données à un fichier texte » dans le blog Delicious Envoyer le billet « Codes VBA Excel pour créer, lire ou ajouter des données à un fichier texte » dans le blog MySpace Envoyer le billet « Codes VBA Excel pour créer, lire ou ajouter des données à un fichier texte » dans le blog Yahoo

Catégories
Excel VBA

Commentaires

  1. Avatar de patmeziere
    • |
    • permalink
    Bonsoir tototiti2008
    pour enrichir ta ressource ,je te propose ces deux fonctions qui te permettent d’écrire ou lire un fichier texte en utf-8 sans utiliser d'object externe ni librairie
    cod c'est le texte a écrire et myfile c'est le chemin du fichier
    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
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    Sub SaveFileUTF_8(Cod, myFile)
        'patricktoulon
    Dim x%, utf8Text() As Byte, BOM(2) As Byte, i%, charCode&, utf8Char() As Byte, utf8Index&, tempText() As Byte, j&
    
    
        BOM(0) = &HEF ' Définir le BOM pour UTF-8 (0xEF, 0xBB, 0xBF)
        BOM(1) = &HBB
        BOM(2) = &HBF
    
        ' Initialiser les tableaux
        ReDim utf8Text(0) ' Initialiser le tableau final avec 0 élément
        utf8Index = 0
    
        ' Encoder manuellement chaque caractère en UTF-8
        For i = 1 To Len(Cod)
            charCode = AscW(Mid(Cod, i, 1))
            Select Case charCode
                Case Is <= &H7F
                    ' 1 octet: 0xxxxxxx
                    ReDim utf8Char(0): utf8Char(0) = charCode
                Case Is <= &H7FF
                    ' 2 octets: 110xxxxx 10xxxxxx
                    ReDim utf8Char(1): utf8Char(0) = &HC0 Or ((charCode \ &H40) And &H1F): utf8Char(1) = &H80 Or (charCode And &H3F)
                Case Is <= &HFFFF
                    ' 3 octets: 1110xxxx 10xxxxxx 10xxxxxx
                    ReDim utf8Char(2)
                    utf8Char(0) = &HE0 Or ((charCode \ &H1000) And &HF): utf8Char(1) = &H80 Or ((charCode \ &H40) And &H3F): utf8Char(2) = &H80 Or (charCode And &H3F)
                Case Else
                    ' 4 octets: 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
                    ReDim utf8Char(3)
                    utf8Char(0) = &HF0 Or ((charCode \ &H40000) And &H7): utf8Char(1) = &H80 Or ((charCode \ &H1000) And &H3F): utf8Char(2) = &H80 Or ((charCode \ &H40) And &H3F)
                    utf8Char(3) = &H80 Or (charCode And &H3F)
            End Select
    
            ' Assurer que utf8Text a assez de place pour les nouveaux octets
            If utf8Index + UBound(utf8Char) > UBound(utf8Text) Then
                ReDim Preserve utf8Text(utf8Index + UBound(utf8Char))
            End If
    
            ' Copier les octets encodés dans utf8Text
            For j = LBound(utf8Char) To UBound(utf8Char)
                utf8Text(utf8Index) = utf8Char(j)
                utf8Index = utf8Index + 1
            Next j
        Next i
    
        ' Réduire la taille finale du tableau utf8Text
        ReDim Preserve utf8Text(utf8Index - 1)
    
        ' Ouvrir le fichier en mode binaire pour l'écriture
        x = FreeFile
        Open myFile For Binary Access Write As #x
        Put #x, , BOM ' Écrire le BOM dans le fichier
        Put #x, , utf8Text ' Écrire le texte UTF-8 dans le fichier
        Close #x ' Fermer le fichier
    End Sub
    
    
    Function ReadFile_UTF_8(filepath)
       'patricktoulon
     Dim fileNum&, fileContent() As Byte, fileSize&, utf8Index&, charCode&, text$, currentByte As Byte
        Dim tempLong1&, tempLong2&, tempLong3&, tempLong4 As Long
        ' Ouvrir le fichier en mode binaire pour la lecture
    
        fileNum = FreeFile
        Open filepath For Binary Access Read As #fileNum
        ' Obtenir la taille du fichier
        fileSize = LOF(fileNum)
        If fileSize > 0 Then ' Lire le contenu du fichier dans un tableau d'octets
            ReDim fileContent(fileSize - 1)
            Get #fileNum, , fileContent
        End If
        Close #fileNum ' Fermer le fichier
    
        ' Vérifier et sauter le BOM si présent
        If fileSize >= 3 Then
            If fileContent(0) = &HEF And fileContent(1) = &HBB And fileContent(2) = &HBF Then
                utf8Index = 3
            Else
                utf8Index = 0
            End If
        End If
        text = "" ' Initialiser la chaîne de résultat
        ' Décoder les octets UTF-8 en caractères Unicode
        Do While utf8Index < fileSize
            currentByte = fileContent(utf8Index)
            Select Case True
                Case (currentByte And &H80) = 0
                    ' 1 octet: 0xxxxxxx
                    charCode = currentByte
                    utf8Index = utf8Index + 1
                Case (currentByte And &HE0) = &HC0
                    ' 2 octets: 110xxxxx 10xxxxxx
                    If utf8Index + 1 < fileSize Then
                        tempLong1 = (currentByte And &H1F) * &H40
                        tempLong2 = fileContent(utf8Index + 1) And &H3F
                        charCode = tempLong1 + tempLong2
                        utf8Index = utf8Index + 2
                    Else
                        Exit Do
                    End If
                Case (currentByte And &HF0) = &HE0
                    ' 3 octets: 1110xxxx 10xxxxxx 10xxxxxx
                    If utf8Index + 2 < fileSize Then
                        tempLong1 = (currentByte And &HF) * &H1000
                        tempLong2 = (fileContent(utf8Index + 1) And &H3F) * &H40
                        tempLong3 = fileContent(utf8Index + 2) And &H3F
                        charCode = tempLong1 + tempLong2 + tempLong3
                        utf8Index = utf8Index + 3
                    Else
                        Exit Do
                    End If
                Case (currentByte And &HF8) = &HF0
                    ' 4 octets: 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
                    If utf8Index + 3 < fileSize Then
                        tempLong1 = (currentByte And &H7) * &H40000
                        tempLong2 = (fileContent(utf8Index + 1) And &H3F) * &H1000
                        tempLong3 = (fileContent(utf8Index + 2) And &H3F) * &H40
                        tempLong4 = fileContent(utf8Index + 3) And &H3F
                        charCode = tempLong1 + tempLong2 + tempLong3 + tempLong4
                        utf8Index = utf8Index + 4
                    Else
                        Exit Do
                    End If
                Case Else
                    ' Octet non valide, passer au suivant
                    utf8Index = utf8Index + 1
                    GoTo NextChar
            End Select
            text = text & ChrW(charCode) ' Ajouter le caractère décodé à la chaîne de résultat
    NextChar:
    Loop
    ReadFile_UTF_8 = text ' return du texte
    End Function
    patrick
  2. Avatar de tototiti2008
    • |
    • permalink
    Merci patmeziere,
    je regarde ça et je vois pour l'ajouter au fichier en te citant