EXCEL :: Les Tableaux Structurés :: Une classe VBA pour mieux les gérer - V1.01 - Evolutions majeures exports CSV, XML, JSON

oguruma · 21 Avril 2025

Bonsoir le Forum,
Pour faire suite à ce POST (Tuto sur les tableaux structurés) voici une classe VBA afin de simplifier les manipulations.
Celle-ci est perfectible.
Bien entendu pour une bonne compréhension du code il est important et nécessaire de connaître la conception de modules de classes en VBA.
C'est une v1.0 . Elle peut évoluer.
Une feuille avec des boutons de démonstration. Le code de démonstration est dans le module : MOD_TEST_CLASS

Version 1.0

Version 1.01
Elle apporte de nouvelles propriétés et méthodes avec une évolution majeure : les exports aux formats .csv, .xml, .json.

Le format CSV

Le code prévoit : le séparateur et le choix d'écraser ou PAS le fichier s'il existe

VB:

Sub exportToCSV_01()
Call INSTANCIATE_02
    Call oTS.exportToCSV("D:\DATA\TestExportToCsv01.csv", , False)
End Sub

Sub exportToCSV_02()
Call INSTANCIATE_02
    Call oTS.exportToCSV("D:\DATA\TestExportToCsv02.csv", Chr(9), True)
End Sub

Le format XML
Volontairement j'ai choisi un format simplifié. Je vous laisse le choix de modifier le code pour formater le fichier selon vos besoins.
Le fichier est bien "well-form" pour l'avoir testé en ligne.

Le format JSON
Volontairement j'ai choisi un format simplifié. Je vous laisse le choix de modifier le code pour formater le fichier selon vos besoins.
Le fichier est bien "well-form" pour l'avoir testé en ligne.

Dans ce post vous trouverez les deux versions 1.0 et 1.01.
Je laisse la v1.0 pour conserver l'historique.

patricktoulon · 28 Avril 2025

bonjour @oguruma
Attention d'aussi loin que je me souvienne
les fonction vba (open file for output) n'ont jamais formaté un fichier text en UTF_8
ça risque de te jouer des tours avec la relecture si il y a des caractère spéciaux avec des eventuels log qui travailleraient en UTF-8

alors oui tu met la ligne de post processig avec le encoding=utf-8 mais elle ne correspond pas au vrai format de fichier qui est certainement en ANSI

oguruma · 28 Avril 2025

patricktoulon à dit:
bonjour @oguruma
Attention d'aussi loin que je me souvienne
les fonction vba (open file for output) n'ont jamais formaté un fichier text en UTF_8
ça risque de te jouer des tours avec la relecture si il y a des caractère spéciaux avec des eventuels log qui travailleraient en UTF-8

alors oui tu met la ligne de post processig avec le encoding=utf-8 mais elle ne correspond pas au vrai format de fichier qui est certainement en ANSI

Bonsoir Patrick, Oup's la bien vu !
c'est une récup de syntaxe d'un autre Dév.... mince je n'ai pas tilté quand je l'ai mis. C'est de l'ANSI.
Je dois avoir un bout de code qui traîne qui se charge des conversions....
Je regarde cela...

Merci. Bonne soirée.

patricktoulon · 28 Avril 2025

95% des log aujourd'hui lisent les xml en utf-8
le faire en Ansi n'a pas vraiment d'intérêt
je voulais la refaire ta sub en bon et due form avec un object xmldom mais plutot je te donne le moyen de l'encoder en utf-8
comme ca on reste dans l'acabit de ton encodage en string

VB:

Sub exportToXML(hFileName As String, Optional hReplace As Integer = True)
    Const PROTOCOL = "<?xml version=""1.0"" encoding=""UTF-8"" ?>"
    Dim iFp As Integer
    Dim vHeaders As Variant
    Dim sRecord As String
    Dim iLig As Long
    Dim iCol As Integer
    Dim iNbrLig As Long
    Dim iNbrCol As Integer
    Dim vColumnValues As Variant
    Dim sZeroes As String
    Dim iRepeat As Long
    Dim CdeXml As String
    If pOTools.isFileExists(hFileName) Then
        If hReplace <> -1 Then
            Err.Raise _
      ERROR_MESSAGE, _
      ERROR_SOURCE, _
      ERROR_MSG & " : Le fichier " & hFileName & " existe déjà"
        End If
    End If
    Close
    vColumnValues = getTableCells
    pNbRows = pDataBody.Rows.Count
    pNbColumns = pDataBody.Columns.Count
    iNbrLig = pDataBody.Rows.Count + 1
    iNbrCol = pDataBody.Columns.Count
    vHeaders = getHeaders()
    iRepeat = Len(CStr(pNbRows))
    sZeroes = String(iRepeat, "0")

    CdeXml = PROTOCOL & vbCrLf
    CdeXml = CdeXml & "<" & pNameTS & ">" & vbCrLf
    For iLig = 2 To iNbrLig
        CdeXml = CdeXml & "<RECORD id=""" & Right(sZeroes & iLig - 1, iRepeat) & """>" & vbCrLf
        For iCol = 1 To iNbrCol
            CdeXml = CdeXml & Chr(9) & "<" & vHeaders(iCol - 1) & ">" & vColumnValues(iLig, iCol) & "</" & vHeaders(iCol - 1) & ">" & vbCrLf
        Next
        CdeXml = CdeXml & "</RECORD>" & vbCrLf
    Next
    CdeXml = CdeXml & "</" & pNameTS & ">"
    Dim oStream
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Charset = "utf-8"
    oStream.Open
    oStream.WriteText CdeXml
    oStream.SaveToFile hFileName, 2
End Sub

et là on a vraiment un utf-8 avec le BOM en bon et due forme

patrick

patricktoulon · 28 Avril 2025

attention aussi le xml a évolué moins que le html mais quand même
les nouvelles applications liront pas ou très mal "<truc>tratatata</truc>
quand il n'y a pas de child on l'écrit comme suit "<truc>tratatata />
d’où le fait que je soit tenté de te la refaire avec un object xmldomdocument
mais bon malgré tout le DOM 1,2 et 3 ont encore de beaux jours devant eux

patricktoulon · 29 Avril 2025

Bonjour @oguruma
je n'ai pas pu m’empêcher de t'ajouter la "exportToHTML" 🤣
cette fonction te crée le html de base (sans format)

VB:

Sub exportToHTML()
Call INSTANCIATE_02
    Call oTS.exportToHTML(ThisWorkbook.Path & "\TestExportToHTML.HTML", True)
End Sub

Dans la classe

VB:

Sub exportToHTML(hFileName As String, Optional hReplace As Integer = True)
   'Auteur :patricktoulon
   Dim vHeaders As Variant
    Dim i As Long
    Dim c As Long
    Dim iNbrLig As Long
    Dim iNbrCol As Integer
    Dim vColumnValues As Variant
    Dim table, TR, TD, TH, COLHTML, Tbody, COL
    Dim CdeHTML As String
    If pOTools.isFileExists(hFileName) Then
        If hReplace <> -1 Then
            Err.Raise _
      ERROR_MESSAGE, _
      ERROR_SOURCE, _
      ERROR_MSG & " : Le fichier " & hFileName & " existe déjà"
        End If
    End If
    Close
    vColumnValues = getTableCells
    iNbrLig = pDataBody.Rows.Count + 1
    iNbrCol = pDataBody.Columns.Count
    vHeaders = getHeaders()

    With CreateObject("htmlfile")
        Set table = .body.appendchild(.createelement("TABLE"))
        table.setattribute "Tableau", CStr(pNameTS)
        table.Style.bordercollapse = "collapse"
        table.Style.TextAlign = "center"
        For c = 0 To UBound(vHeaders)
            Set COL = table.appendchild(.createelement("COL"))
            COL.Style.Width = Round(pDataBody.Cells(1, c + 1).Width) & "pt"
        Next
        Set Tbody = table.appendchild(.createelement("TBODY"))
        Set TR = Tbody.appendchild(.createelement("TR"))
        For c = 0 To UBound(vHeaders)
            Set TH = TR.appendchild(.createelement("TH"))
            TH.innerhtml = CStr(vHeaders(c))
            TH.Style.Border = "0.5pt solid black"
        Next
        For i = 2 To iNbrLig
            Set TR = Tbody.appendchild(.createelement("TR"))
            For c = 1 To iNbrCol
                Set TD = TR.appendchild(.createelement("TD"))
                TD.innerhtml = vColumnValues(i, c)
                TD.Style.Border = "0.5pt solid black"
            Next
        Next
        'Debug.Print .body.innerhtml

        Dim oStream
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Charset = "utf-8"
        oStream.Open
        oStream.WriteText table.outerhtml
        oStream.SaveToFile hFileName, 2
    End With
End Sub

oguruma · 29 Avril 2025

Bon

patricktoulon à dit:

Bonjour @oguruma
je n'ai pas pu m’empêcher de t'ajouter la "exportToHTML" 🤣
cette fonction te crée le html de base (sans format)

VB:

Sub exportToHTML()
Call INSTANCIATE_02
    Call oTS.exportToHTML(ThisWorkbook.Path & "\TestExportToHTML.HTML", True)
End Sub

Dans la classe

VB:

Sub exportToHTML(hFileName As String, Optional hReplace As Integer = True)
   'Auteur :patricktoulon
   Dim vHeaders As Variant
    Dim i As Long
    Dim c As Long
    Dim iNbrLig As Long
    Dim iNbrCol As Integer
    Dim vColumnValues As Variant
    Dim table, TR, TD, TH, COLHTML, Tbody, COL
    Dim CdeHTML As String
    If pOTools.isFileExists(hFileName) Then
        If hReplace <> -1 Then
            Err.Raise _
      ERROR_MESSAGE, _
      ERROR_SOURCE, _
      ERROR_MSG & " : Le fichier " & hFileName & " existe déjà"
        End If
    End If
    Close
    vColumnValues = getTableCells
    iNbrLig = pDataBody.Rows.Count + 1
    iNbrCol = pDataBody.Columns.Count
    vHeaders = getHeaders()

    With CreateObject("htmlfile")
        Set table = .body.appendchild(.createelement("TABLE"))
        table.setattribute "Tableau", CStr(pNameTS)
        table.Style.bordercollapse = "collapse"
        table.Style.TextAlign = "center"
        For c = 0 To UBound(vHeaders)
            Set COL = table.appendchild(.createelement("COL"))
            COL.Style.Width = Round(pDataBody.Cells(1, c + 1).Width) & "pt"
        Next
        Set Tbody = table.appendchild(.createelement("TBODY"))
        Set TR = Tbody.appendchild(.createelement("TR"))
        For c = 0 To UBound(vHeaders)
            Set TH = TR.appendchild(.createelement("TH"))
            TH.innerhtml = CStr(vHeaders(c))
            TH.Style.Border = "0.5pt solid black"
        Next
        For i = 2 To iNbrLig
            Set TR = Tbody.appendchild(.createelement("TR"))
            For c = 1 To iNbrCol
                Set TD = TR.appendchild(.createelement("TD"))
                TD.innerhtml = vColumnValues(i, c)
                TD.Style.Border = "0.5pt solid black"
            Next
        Next
        'Debug.Print .body.innerhtml

        Dim oStream
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Charset = "utf-8"
        oStream.Open
        oStream.WriteText table.outerhtml
        oStream.SaveToFile hFileName, 2
    End With
End Sub

Regarde la pièce jointe 1217147

Bonjour Patrick, tu as très bien fait 🙂
le dév collaboratif... j'adhère totalement
et ça va dans la logique des choses quand je suis intervenu sur ta barre de progression 😉
merci, je vais l'intégrer dans la version officielle pour une nouvelle publication 🙂 bonne journée.

oguruma · 29 Avril 2025

patricktoulon à dit:
attention aussi le xml a évolué moins que le html mais quand même
les nouvelles applications liront pas ou très mal "<truc>tratatata</truc>
quand il n'y a pas de child on l'écrit comme suit "<truc>tratatata />
d’où le fait que je soit tenté de te la refaire avec un object xmldomdocument
mais bon malgré tout le DOM 1,2 et 3 ont encore de beaux jours devant eux

"es nouvelles applications liront pas ou très mal "<truc>tratatata</truc>" tu as raison
cependant on trouve encore bcp de fichiers sous cette forme et j'ai même été contraint de respecter cette syntaxe il y a certes qq années pour des conversions de fichiers issus de la reconnaissance automatique de caractères pour les transformer en PDF/A sous Linux - un projet de démat de brevets pour l'OEB (office européen des brevets) - c'était du Shell Linux à Donfff avec du Pearl histoire de s'amuser un peu avec les RegExp 🙂
Tu as carte blanche pour la nouvelle version... fais toi plaiz

patricktoulon · 29 Avril 2025

et voici comment on fait du xml pur et dur conforme
avec un dom document le code est linéaire mais parfaitement exploitable
si l'on veut une indentation digne de ce nom on a le MSXML2.SAXXMLReader pour ça
du coup basé sur ma fonction d'indentation du créatorribbonX je t'ai fait une fonction minimale qui va te permettre d'indenter le code XML
je travaille en late binding ((createObject) donc pas de ref a cocher)

Code:

Sub exportToXML_02()
Call INSTANCIATE_02
    Call oTS.exportToXML2(ThisWorkbook.Path & "\TestExportToXML.xml", True)
End Sub

Dans la classe

VB:

Sub exportToXML2(hFileName As String, Optional hReplace As Integer = True)
    'Auteur :patricktoulon
    Dim vHeaders As Variant
    Dim i As Long
    Dim c As Long
    Dim iNbrLig As Long
    Dim iNbrCol As Integer
    Dim vColumnValues As Variant
    Dim XmlDoc, Postprocc, ROOT, Record, elem, oStream

    If pOTools.isFileExists(hFileName) Then
        If hReplace <> -1 Then
            Err.Raise _
      ERROR_MESSAGE, _
      ERROR_SOURCE, _
      ERROR_MSG & " : Le fichier " & hFileName & " existe déjà"
        End If
    End If
    Close

    vColumnValues = getTableCells
    iNbrLig = pDataBody.Rows.Count + 1
    iNbrCol = pDataBody.Columns.Count
    vHeaders = getHeaders()
    Set XmlDoc = CreateObject("Microsoft.XMLDOM") 'CREATION D'UN DOMDOCUMENT XML
    With XmlDoc
        Set ROOT = .appendchild(.createelement(CStr(pNameTS))) 'CREATION DE L'ELEMENT ROOT
        'creation et intégration du post processing
        Set Postprocc = .createProcessingInstruction("xml", "version=""1.0"" encoding=""UTF-8""") 'creation de l'entete du processing
        .InsertBefore Postprocc, .ChildNodes.Item(0) 'insertion parametre processing
        'ajout des elements
        For i = 2 To iNbrLig
            Set Record = ROOT.appendchild(.createelement("RECORD_0" & i - 1))
            For c = 1 To iNbrCol
                Set elem = Record.appendchild(.createelement(pDataBody.Cells(1, c).Offset(-1)))
                elem.Text = pDataBody.Cells(1, c)
            Next
        Next
        'arrivé ici on a le code xml  en format zip (tout accroché)
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Charset = "utf-8"
        oStream.Open
        oStream.WriteText IndenterXMLCode(XmlDoc.XML)'on passe par la fonction d'indentation pour l'ecriture avec indentation
        oStream.SaveToFile hFileName, 2
    End With
End Sub

'version 2 en memoire
'Fonction basique minimale pour indenter un code xml(issue de creatorribbonx (patricktoulon))
Public Function IndenterXMLCode(ByVal vDomOrString As Variant) As String
    Dim XMLWriter As Object ' MSXML2.MXXMLWriter
    On Error GoTo QH
    Set XMLWriter = CreateObject("MSXML2.MXXMLWriter")
    XMLWriter.indent = True 'ajoute l'attribut indent
    With CreateObject("MSXML2.SAXXMLReader")
        Set .contentHandler = XMLWriter
        .Parse vDomOrString
    End With
    IndenterXMLCode = Replace(Replace(XMLWriter.output, "UTF-16", "UTF-8"), "standalone=""no""", "")
    Exit Function
QH:
End Function

je join le fichier modifié

oguruma · 29 Avril 2025

patricktoulon à dit:

et voici comment on fait du xml pur et dur conforme
avec un dom document le code est linéaire mais parfaitement exploitable
si l'on veut une indentation digne de ce nom on a le MSXML2.SAXXMLReader pour ça
du coup basé sur ma fonction d'indentation du créatorribbonX je t'ai fait une fonction minimale qui va te permettre d'indenter le code XML
je travaille en late binding ((createObject) donc pas de ref a cocher)

Code:

Sub exportToXML_02()
Call INSTANCIATE_02
    Call oTS.exportToXML2(ThisWorkbook.Path & "\TestExportToXML.xml", True)
End Sub

Dans la classe

VB:

Sub exportToXML2(hFileName As String, Optional hReplace As Integer = True)
    'Auteur :patricktoulon
    Dim vHeaders As Variant
    Dim i As Long
    Dim c As Long
    Dim iNbrLig As Long
    Dim iNbrCol As Integer
    Dim vColumnValues As Variant
    Dim XmlDoc, Postprocc, ROOT, Record, elem, oStream

    If pOTools.isFileExists(hFileName) Then
        If hReplace <> -1 Then
            Err.Raise _
      ERROR_MESSAGE, _
      ERROR_SOURCE, _
      ERROR_MSG & " : Le fichier " & hFileName & " existe déjà"
        End If
    End If
    Close

    vColumnValues = getTableCells
    iNbrLig = pDataBody.Rows.Count + 1
    iNbrCol = pDataBody.Columns.Count
    vHeaders = getHeaders()
    Set XmlDoc = CreateObject("Microsoft.XMLDOM") 'CREATION D'UN DOMDOCUMENT XML
    With XmlDoc
        Set ROOT = .appendchild(.createelement(CStr(pNameTS))) 'CREATION DE L'ELEMENT ROOT
        'creation et intégration du post processing
        Set Postprocc = .createProcessingInstruction("xml", "version=""1.0"" encoding=""UTF-8""") 'creation de l'entete du processing
        .InsertBefore Postprocc, .ChildNodes.Item(0) 'insertion parametre processing
        'ajout des elements
        For i = 2 To iNbrLig
            Set Record = ROOT.appendchild(.createelement("RECORD_0" & i - 1))
            For c = 1 To iNbrCol
                Set elem = Record.appendchild(.createelement(pDataBody.Cells(1, c).Offset(-1)))
                elem.Text = pDataBody.Cells(1, c)
            Next
        Next
        'arrivé ici on a le code xml  en format zip (tout accroché)
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Charset = "utf-8"
        oStream.Open
        oStream.WriteText IndenterXMLCode(XmlDoc.XML)'on passe par la fonction d'indentation pour l'ecriture avec indentation
        oStream.SaveToFile hFileName, 2
    End With
End Sub

'version 2 en memoire
'Fonction basique minimale pour indenter un code xml(issue de creatorribbonx (patricktoulon))
Public Function IndenterXMLCode(ByVal vDomOrString As Variant) As String
    Dim XMLWriter As Object ' MSXML2.MXXMLWriter
    On Error GoTo QH
    Set XMLWriter = CreateObject("MSXML2.MXXMLWriter")
    XMLWriter.indent = True 'ajoute l'attribut indent
    With CreateObject("MSXML2.SAXXMLReader")
        Set .contentHandler = XMLWriter
        .Parse vDomOrString
    End With
    IndenterXMLCode = Replace(Replace(XMLWriter.output, "UTF-16", "UTF-8"), "standalone=""no""", "")
    Exit Function
QH:
End Function

je join le fichier modifié

Re.... OK, merci.... je fais le Bundle complet et je shoot tout ça en ligne pour une V+n, grand merci

patricktoulon · 29 Avril 2025

oups! j'ai fait une boulette dans la xml2

VB:

   Set elem = Record.appendchild(.createelement(pDataBody.Cells(1, c).Offset(-1)))
                elem.Text = pDataBody.Cells(i - 1, c)

patricktoulon · 29 Avril 2025

si tu veux des trucs sur le DOM (html ou xml) n’hésite pas

oguruma · 29 Avril 2025

patricktoulon à dit:
si tu veux des trucs sur le DOM (html ou xml) n’hésite pas

volontier 🙂
j'ai fait ça y a longtemps en lotus/script... (Lotus Notes/Domino) si ça te parle....
Ex Architecte Lotus Notes/ Domino Server chez IBM ça remonte dans les années 2005 à 2010....
on passait par du xmldom pour convertir des documents Lotus Notes d'une base .nsf et les envoyer dans une base documentaire opensource...style documentum (je suis certain que ça te parle.... 🙂) pour un grand ministère dont je ne citerai pos le nom.... projet qui n'a jamais abouti.... après des mois sur un POC
c'était la grande mode dans les administrations où on abandonnait les logiciels payants pour passer en OpenSource
style passerelle pour convertir des .nsf mail de Lotus Notes et les injecter dans Thunderbird et récupérer les carnets d'adresses names.nsf des postes locaux.... une grande aventure 🙂

oguruma · 29 Avril 2025

patricktoulon à dit:
oups! j'ai fait une boulette dans la xml2

VB:

Set elem = Record.appendchild(.createelement(pDataBody.Cells(1, c).Offset(-1))) elem.Text = pDataBody.Cells(i - 1, c)

tu as de la chance je ne l'ai pas encore intégré dans la version future version.... un peu de sérieux voyons ... 😀 je plaisante

oguruma · 1 Mai 2025

patricktoulon à dit:
oups! j'ai fait une boulette dans la xml2

VB:

Set elem = Record.appendchild(.createelement(pDataBody.Cells(1, c).Offset(-1))) elem.Text = pDataBody.Cells(i - 1, c)

Bonjour Patrick,
en préambule bonne fête du 1er mai
v1.03 en cours de construction avec reprise de ton code et correction sur le < i - 1 >
pour être complet je vais ajouter l'export d'un tableau en PDF et image, c'était ce que j'avais fait dans un projet pour les envoyer par mail en mode html
devrait suivre bientôt d'autres classes complémentaires....

EXCEL :: Les Tableaux Structurés :: Une classe VBA pour mieux les gérer - V1.01 - Evolutions majeures exports CSV, XML, JSON

oguruma

XLDnaute Impliqué

Pièces jointes

patricktoulon

XLDnaute Barbatruc

oguruma

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

oguruma

XLDnaute Impliqué

oguruma

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

Pièces jointes

oguruma

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

oguruma

XLDnaute Impliqué

oguruma

XLDnaute Impliqué

oguruma

XLDnaute Impliqué

Discussions similaires

EXCEL :: Les Tableaux Structurés :: Une classe VBA pour mieux les gérer - V1.01 - Evolutions majeures exports CSV, XML, JSON

XLDnaute Impliqué

Pièces jointes

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency