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

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
oguruma

oguruma

XLDnaute Impliqué
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

1745265112002.png


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

1745350806674.png

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

1745350927948.png


1745350953436.png


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.
1745351000683.png


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.
1745351119468.png


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

Pièces jointes

Dernière édition:
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
 
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
Cliquez pour agrandir...
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.
 
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
1745868446169.png

patrick
 
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


 
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
1745911426499.png
 
Dernière édition:
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
Cliquez pour agrandir...
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.
 
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
Cliquez pour agrandir...
"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
 
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é
 

Pièces jointes

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é
Cliquez pour agrandir...
Re.... OK, merci.... je fais le Bundle complet et je shoot tout ça en ligne pour une V+n, grand merci
 
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 à dit:
si tu veux des trucs sur le DOM (html ou xml) n’hésite pas
Cliquez pour agrandir...
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 🙂
 
Dernière édition:
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)
Cliquez pour agrandir...
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....
 
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

oguruma
EXCEL :: Les Tableaux Structurés :: Une classe VBA pour mieux les gérer - V1.03 - Evolutions majeures exports CSV, XML, XML UTF-8, JSON, HTML
Réponses
1
Affichages
304
oguruma
oguruma
oguruma
EXCEL :: Les Tableaux Structurés :: Une classe VBA - V1.05 - Evolutions majeures exports CSV, XML, XML UTF-8, JSON, HTML, PDF, JPG, JPEG, BMP, EXCEL
Réponses
10
Affichages
684
oguruma
oguruma
oguruma
EXCEL :: Les Tableaux Structurés :: Une classe VBA - V2.0 + 2.01 - exports CSV, XML, XML UTF-8, JSON, HTML, PDF, JPG, JPEG, BMP, EXCEL
Réponses
2
Affichages
270
oguruma
oguruma
oguruma
EXCEL :: Les Tableaux Structurés :: Une classe VBA - V2.1 - exports CSV, XML, XML UTF-8, JSON, HTML, PDF, JPG, JPEG, BMP, EXCEL
Réponses
0
Affichages
295
oguruma
oguruma
oguruma
EXCEL :: Les Tableaux Structurés :: Une classe VBA - V1.06+1.07 - exports CSV, XML, XML UTF-8, JSON, HTML, PDF, JPG, JPEG, BMP, EXCEL
2 3 4
Réponses
49
Affichages
2 K
oguruma
oguruma
oguruma
EXCEL :: Les Tableaux Structurés :: Une classe VBA pour mieux les gérer - V1.02
Réponses
4
Affichages
548
bsalv
B
Retour