Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion oguruma
  • Date de début Date de début

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
ahhhh mince j'ai loupé ce dernier post.... je vois comment je peux faire... sans doute des appels à tiroirs avec plusieurs options de manière à ne pas tout casser..... ou certainement faire une nouvelle fonction "extended" - merci
 
je peux poser une rtt demain ? lol 😀
 
non c'est simple je t'ai tout préparé et tu a 3 exemple du comment il faut faire pour la ligne total
pourquoi veux tu tout casser
regarde 1 minute et demie
le csv
VB: 
Sub exportToCSV(hFileName As String, Optional hSep As String = ";", Optional hReplace As Integer = True)
    Dim iFp As Integer
    Dim sColumnsHeader As String
    Dim sRecord As String
    Dim iLig As Long
    Dim iCol As Integer
    Dim iNbrLig As Long
    Dim iNbrCol As Integer
    Dim vColumnValues As Variant

    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
    iFp = FreeFile
    ' sColumnsHeader = getHeaderToString()
    ' Print #iFp, sColumnsHeader
    Open hFileName For Output As iFp
    vColumnValues = getTableCells
    sRecord = ""
    pNbRows = pDataBody.Rows.Count
    pNbColumns = pDataBody.Columns.Count
    iNbrLig = pDataBody.Rows.Count + 1
    iNbrCol = pDataBody.Columns.Count
    For iLig = 1 To iNbrLig
        sRecord = ""
        For iCol = 1 To iNbrCol
            sRecord = sRecord & vColumnValues(iLig, iCol) & hSep
        Next

        Print #iFp, sRecord
    Next
    '------------------------------------------------------------
    If HasTotalRow Then
        sRecord = ""
        For iCol = 1 To iNbrCol
            sRecord = sRecord & pDataTotalBody.Cells(iCol) & hSep
        Next
    End If
    Print #iFp, sRecord
    '-------------------------------------------------------

    Close iFp
End Sub
 
allez le html maintenant
VB: 
'*************************************************************************************
'* exportToXML2, IndenterXMLCode, exportToHTML
'* Auteur : Patrick TOULON sur https://excel-downloads.com/
'* Tous mes remerciements pour sa collaboration et échanges de lignes de code
'* Ajout à cette version 1.03 le 01/05/2025
'*************************************************************************************
Sub exportToHTML(hFileName As String, Optional hReplace As Integer = True)
    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
       '-------------------------------------------------------
        If HasTotalRow Then
         Set TR = Tbody.appendchild(.createelement("TR"))
          TR.setattribute "Total", ""
          For c = 1 To iNbrCol
         Set TD = TR.appendchild(.createelement("TD"))
                TD.innerhtml = pDataTotalBody.Cells(c)
                TD.Style.Border = "0.5pt solid black"
           Next
        End If
        '-------------------------------------------------------
       
        '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
pas compliqué
c'est pas du bon htmlboul ça
 
Bonjour Patrick, ok j'intègre tout cela, grand merci on aura une belle classe digne de ce nom ! 🙂
 
oguruma à dit:
Bonjour Patrick, ok j'intègre tout cela, grand merci on aura une belle classe digne de ce nom ! 🙂
Cliquez pour agrandir...
re,
je ne suis peut-être pas bien réveillé mais il n'y a pas un doublon entre #19 et #20, je pense que le #20 concernait du xml... où alors... j'ai pas bien lu 🙂
 
Bonjour @oguruma
ben non c'est bien le html c'est tes commentaires que tu a mis qui t'induisent en erreur
j'ai fait
le csv
le xml 1
le xml 2
le xml 3
le html
voici le fichier c'est ta version 1.06 donc la dernière avec le correctif (workbook/workbookquery)
je te laisse faire le JSON ou je le fait ?
 

Pièces jointes

fais toi plaizzz t'es chaud
 
Merci
 
Hello,
patricktoulon tu peux réduire la taille de ton fichier de sortie en définissant un style par défaut par exemple pour les td ( à ajouter au début du html) :
HTML: 
<head>
<style>
td
    {border: 0.5pt solid black;
     border-image: none;
    color:black;
    font-size:12.0pt;
    font-weight:400;
    font-style:normal;
    text-decoration:none;
    font-family:Calibri, sans-serif;
    }
</style></head>
Dans ce cas plus la peine d'ajouter l'attribut style dans les td sauf si on veut changer une ou plusieurs des propriétés (qui seront prioritaires)

Ami calmant, J.P
 
J'ai changé le mode de balayage du tableau... ça faisait un moment que ça me turlupiné car on tenait pas compte des Headers ou pas...

voici donc ce qui sera intégré dans la prochaine version.... c'est encore en test...

VB: 
Sub exportToCSV(hFileName As String, Optional hSep As String = ";", Optional hReplace As Integer = True, Optional hHeader As Boolean = False)
    Dim iFp As Integer
    Dim sColumnsHeader As String
    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 rRangeToCSV As Range

    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
   
    If hHeader Then
        'V1.08
        Set rRangeToCSV = pDataBody.Offset(-1).Resize(pDataBody.Rows.Count + 1)
    Else
        Set rRangeToCSV = pDataBody
    End If

    Close
    iFp = FreeFile
    ' sColumnsHeader = getHeaderToString()
    ' Print #iFp, sColumnsHeader
    Open hFileName For Output As iFp
    vColumnValues = getTableCells
    sRecord = ""
    pNbRows = pDataBody.Rows.Count
    pNbColumns = pDataBody.Columns.Count
    iNbrLig = pDataBody.Rows.Count + 1
    iNbrCol = pDataBody.Columns.Count
   
    'V1.08 On passe par un range - ce qui est mieux
    For iLig = 1 To rRangeToCSV.ListObject.ListRows.Count
        sRecord = ""
        For iCol = 1 To iNbrCol
            sRecord = sRecord & rRangeToCSV.Cells(iLig, iCol) & hSep
        Next
        Print #iFp, sRecord
    Next
   
    '------ V1.08
    ' On sécurise RAZ
    iLig = 0
    iCol = 0
   
    If phasTotalRow Then
        sRecord = ""
        For iCol = 1 To iNbrCol
            sRecord = sRecord & pDataTotalBody.Cells(iCol) & hSep
        Next
        Print #iFp, sRecord
    End If

    '-------------------------------------------------------
   
    Close iFp

End Sub

en effet.... en prenant en compte ton code la ligne total se mettait en double.... il fallait trouver la parade.... d'où la refonte de la méthode de balayage... c'est un peu bourrin mais ça fonctionne
 
Dernière édition:
la je te comprends plus
pourquoi tu fait ça
VB: 
  Set rRangeToCSV = pDataBody.Offset(-1).Resize(pDataBody.Rows.Count + 1)
alors que je n'ai rien touché de ton code original
le ptable c'est le tableau
le pdatabody c'est le databodyrange
et le pdatatotablBody c'est le range de la ligne total
j'ai juste ajoute deux variables pour fonctionner façon oguruma et garder ton acabit de code

et toi tu me fait des resize offset ????
ta perdu la tête????? 🤣 🤣 🤣
regarde tes déclarations
Enrichi (BBcode): 
Private Const ERROR_MESSAGE As Long = vbObjectError + 9100
Private Const ERROR_SOURCE As String = "CLS_TS"
Private Const ERROR_MSG As String = ":: ABANDON - 9100 :: Incident de traitement :: "

Private pOTools As CLS_TOOLS_EXISTS

Private pWb_MACRO As Workbook
Private pWk As Worksheet
Private pTable As ListObject
Private pObjectTable As ListObject
Private pIsExistsQueryTable As Boolean
Private pQueryTable As QueryTable

Private pRange As Range
Private pDataBody As Range
Private pHeaders As Range
Private pTblHeaders As Variant
Private pDataTotalBody As Range 'le range de la ligne total

Private pListRows As ListRows
Private pListColumns As ListColumns
Private pRow As ListRow
Private pColumn As ListColumn
Private HasTotalRow As Boolean 'flag du showtotals

Private pNameTS As String
Private pNbRows As Long
Private pTableNbRows As Long
Private pNbColumns As Integer
Private pAddressData As String
'---------
' V1.01
'---------
Private pWkName As String
Private pDataRow As Long
Private pDataColumn As Integer
Private pHeaderAddress As String
Private pHeaderRow As Long
Private pHeaderColumn As Integer
'---------
' V1.02
'---------
Private pQueryTableCommandText As String
Private pQueryTableConnection As String
Private pQueryTableBackGroundQuery As Boolean
Private pQueryTableWorkbookConnection As WorkbookConnection
Private pQueryTableWorkbookConnectName As String
Private pQueryTableWorkbookConnectDescr As String
Private pQueryTableLocation As String
ensuite dans le instanciate
Enrichi (BBcode): 
 Set pTable = wk.ListObjects(hTB)
    Set pRange = Range(hTB & "[#All]") ' V1.05 ça manquait, prévu mais non initialisé
    HasTotalRow = wk.ListObjects(hTB).ShowTotals = True
    If HasTotalRow Then Set pDataTotalBody = wk.ListObjects(hTB).TotalsRowRange
    Set pDataBody = pTable.DataBodyRange
    Set pObjectTable = Range(hTB).ListObject

parti de la ben tu l'a vu
je te sent une fatigue latente dans l'élaboration ton projet
 
re
pour le JSON
VB: 
Sub exportToJSON(hFileName As String, Optional hReplace As Integer = True)
    Const DEBUT_TABLEAU = "["
    Const FIN_TABLEAU = "]"
    Const DEBUT_RECORD = "{"
    Const FIN_RECORD = "}"

    Dim iFp As Integer
    Dim vHeaders As Variant
    Dim sRecord As String
    Dim sVirgule As String
    Dim iLig As Long
    Dim iCol As Integer
    Dim iCptLig As Long
    Dim iCptCol As Integer
    Dim iNbrLig As Long
    Dim iNbrCol As Integer
    Dim vColumnValues As Variant

    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
    iFp = FreeFile

    vColumnValues = getTableCells
    sRecord = ""
    pNbRows = pDataBody.Rows.Count
    pNbColumns = pDataBody.Columns.Count
    iNbrLig = pDataBody.Rows.Count + 1
    iNbrCol = pDataBody.Columns.Count
    vHeaders = getHeaders()
    iCptLig = 1
    Open hFileName For Output As iFp
    Print #iFp, DEBUT_TABLEAU
    For iLig = 2 To iNbrLig
        iCptLig = iCptLig + 1
        iCptCol = 0
        Print #iFp, DEBUT_RECORD
        sRecord = ""
        sVirgule = ""
        For iCol = 1 To iNbrCol
            iCptCol = iCptCol + 1
            If iCptCol <> iNbrCol Then sVirgule = "," Else sVirgule = ""
            sRecord = Chr(34) & vHeaders(iCol - 1) & Chr(34) & ": " & Chr(34) & vColumnValues(iLig, iCol) & Chr(34) & sVirgule
            Print #iFp, sRecord
        Next
        If iCptLig <> iNbrLig Then sVirgule = "," Else sVirgule = ""
        Print #iFp, FIN_RECORD & sVirgule

    Next
    Print #iFp, DEBUT_RECORD
    For iCol = 1 To iNbrCol
        If iCol < iNbrCol Then sVirgule = "," Else sVirgule = ""
        sRecord = Chr(34) & vHeaders(iCol - 1) & Chr(34) & ": " & Chr(34) & pDataTotalBody(iCol) & Chr(34) & sVirgule
        Print #iFp, sRecord
    Next
    Print #iFp, FIN_RECORD

    Print #iFp, FIN_TABLEAU
    Close iFp
End Sub
 
" je te sent une fatigue latente dans l'élaboration ton projet" ==> j'ai la crève... j'ai l'impression d'avoir soulever des parpaings toute la nuit..🙁
je vais laisser en l'état pour le moment... je reprendrais quand les conditions physiques seront meilleures 😉
 
je suis en train de te finir la V 1.7
pour la(CSV, JSON , XML3 , HTML) tu a" la" possibilité d'exporter la table avec le header ou pas et le total ou pas
comme ça faisait un peu trop de bouton j'ai fait un menu popup
 
Identifiez-vous ou inscrivez-vous pour participer.
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

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
290
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
666
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
264
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
295
oguruma
EXCEL :: Les Tableaux Structurés :: Une classe VBA pour mieux les gérer - V1.01 - Evolutions majeures exports CSV, XML, JSON
2
Réponses
28
Affichages
1 K
oguruma
EXCEL :: Les Tableaux Structurés :: Une classe VBA pour mieux les gérer - V1.02
Réponses
4
Affichages
529
bsalv
B
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…