remettre les guillemet a leur place (vba/html)

patricktoulon

XLDnaute Barbatruc
bonjour a tous
j'ai enfin trouvé le moyen d'indenter du code html par vba
mais ma fonction d'indentation n'accepte pas les attributs des éléments sans les guillemets
pour mon indentation j'ai du recourir au remplacements des childnodes type nodetext par des balise "PRE"
et donc après ce replacement des nodetext le body.innerhtml ne contient plus les attributs entre guillemets
il me faut donc les remettre
problème element.attributes me renvoie le 128 à 139 attributs possibles dans une boucle for each att in .attibutes alors que j'en ai qu'un ou deux
si quelqu'un a une idée je prends ;)
VB:
Sub test()

    Dim code$, i&, elem As Object, t, x&
    code = "<html><body><div><font color=""red"" face=""Algerian"">toto<B> la <em>grosse</em>  fritte</B></font><font size=""4""><S>toto</S><B>la grosse anguille</B></font></div></body></html>"
    With CreateObject("htmlfile")
        .body.innerhtml = code
        For Each elem In .body.all
            If elem.ChildNodes.Length > 1 And elem.ChildNodes(0).NodeType = 3 Then
                For Each nod In elem.ChildNodes
                    If nod.NodeType = 3 Then
                        Set pre = .createelement("pre"): pre.innerhtml = Replace(nod.NodeValue, " ", "&nbsp;")
                        elem.InsertBefore pre, nod.NextSibling
                        elem.RemoveChild (nod)
                    End If
                Next
            End If
        Next
        code = CStr(.body.innerhtml)
       For Each elem In .all
       code = Replace(Replace(code, "<" & elem.tagname, vbCrLf & "<" & elem.tagname), vbCrLf & vbCrLf, vbCrLf)
       Next
       Debug.Print code
       ' MsgBox Indenter_HTML_XML_Code(code)'pour après correction des guillemets
    End With
End Sub
allez les crack vba/html ;)
 
Dernière édition:

fanch55

XLDnaute Accro
Salut Patrick,

Sur 2016, j'ai du remplacer le
If elem.ChildNodes.Length > 1 And elem.ChildNodes(0).NodeType = 3 Then
par
If elem.ChildNodes.Length > 1 And elem.ChildNodes.Item(0).NodeType = 3 Then

Pour rajouter les attributs (mais en style CSS):

VB:
 Set Pre = .createelement("pre"): Pre.innerhtml = Replace(nod.NodeValue, " ", "&nbsp;")
     Pre.setattribute "style", "color:red;font-family:Algerian"
 

patricktoulon

XLDnaute Barbatruc
merci fanch55 c'est pas si mal l'idée mais j'ai résolu mon problème sans dénaturer le code

bon j'ai résolu mon problème par hasard et j'ai donc fait une découverte
j'ai testé en remplacant le "=" des caractères et je me suis aperçu qu'ajouter le "$" a chaque noms d'attributs ,le dom mettait les guillemets tout seul dans le DOMdocument
BINGO je fait un replace de tout les "=" par "$=" et le tour est joué
dans le cas ou le caractere"=" serait ou ferait part d'un nodetext
je fait la correction dans une boucle
et voila mes guillemets son a la sortie même si ils n'y était pas dans le code de base
j'ai vraiment fait une découverte aujourd'hui :D :cool:
et donc après tests ma fonction d'indentation marche a merveille
allez j'envoie la sauce
voici le code éprouvette beta qui deviendra une fonction

VB:
Sub test()

    Dim Code$, i&, elem As Object, t, x&, ok As Boolean
    Code = "<html><body><div><font color=red face=Algerian>toto<B> la <em>grosse</em>  fr$itte</B></font><font size=7><S>toto</S><B>la grosse anguille</B></font></div></body></html>"
    Code = Replace(Code, "=", "$=")    'le fait de mettre le "$" ajoute ou appui les guillemets en DOM (découverte)
    With CreateObject("htmlfile")
        .body.innerhtml = Code
        For Each elem In .body.all    'attention le signe egal peut etre du text alors on corrige le replace
            If elem.Children.Length = 0 Then If elem.innertext Like "*$*" Then elem.innerhtml = Replace(elem.innertext, "$", "")
        Next
        For Each elem In .body.all
            If elem.ChildNodes.Length > 1 And elem.ChildNodes.Item(0).NodeType = 3 Then
                For Each nod In elem.ChildNodes
                    If nod.NodeType = 3 Then
                        Set pre = .createelement("pre"): pre.innerhtml = Replace(nod.NodeValue, " ", "|")
                        elem.InsertBefore pre, nod.NextSibling
                        elem.RemoveChild (nod)
                    End If
                Next
            End If
        Next
        ' Debug.Print .body.innerhtml
        Code = Replace(.body.outerhtml, "$", "")    'on peut maintenant supprimer les "$"
        Code = Indenter_HTML_XML_Code(Code)
        Code = Replace(Replace(Replace(Code, "<PRE>", ""), "</PRE>", ""), "|", " ")
        MsgBox Code
          End With
    fichier = Environ("userprofile") & "\Desktop\fichier de sortie.html"
    x = FreeFile: Open fichier For Output As #x: Print #x, Code: Close #x
End Sub

et voici ma fonction d'indentation
en fait j'utilise celle du XML (astuce sortie de la cave a toto :cool: :D ;):p)

VB:
Public Function Indenter_HTML_XML_Code(Code As String) As String
    Dim XMLWriter As Object    ' MSXML2.MXXMLWriter
    Indenter_HTML_XML_Code = "il y a des erreurs dans le code"
    On Error GoTo QH
    Set XMLWriter = CreateObject("MSXML2.MXXMLWriter")
    XMLWriter.indent = True    'ajoute l'attribut indent
    XMLWriter.omitXMLDeclaration = True    'supprime la declaration processing
    With CreateObject("MSXML2.SAXXMLReader")
        Set .contentHandler = XMLWriter
        Set .errorHandler = XMLWriter
        .Parse Code
    End With
    '--- success
    Indenter_HTML_XML_Code = Replace(XMLWriter.Output, vbTab, "    ")
    Exit Function
QH:
End Function
un fichier est enregistrer sur le bureau
démonstration
demo6.gif


vue du fichier enfonctionnement dans IE avec vu de la source et vue du fichier ouvert avec bloque note
Capture.JPG



PS: du coup on peut supprimer "And elem.ChildNodes.Item(0).NodeType = 3" du code
 
Dernière édition:
Haut Bas