'créer un code html valide et indentation
'auteur patricktoulon
Private Sub CommandButton3_Click() 'bouton indenter
TextBox1 = htmlCodeIndenter(TextBox1)
End Sub
Private Sub CommandButton1_Click() 'bouton copie
With New DataObject: .SetText (TextBox1.Text): .PutInClipboard: End With
End Sub
Private Sub CommandButton2_Click() 'bouton actualiser
Dim doc As Object
Set r = Range("Tableau1[#all]")
ligne = 2 'adapter la ligne ici
Set doc = CreateObject("htmlfile")
With doc.body.appendchild(doc.createelement("div"))
.Style.TextAlign = "center"
'1er div avec boutons
With .appendchild(doc.createelement("Strong"))
For i = 2 To r.Columns.Count
With .appendchild(doc.createelement("input"))
.setattribute "type", "button"
.onclick = "myframe.location.href='" & r.Cells(ligne, i).Value & "'"
.Value = r.Cells(1, i).Value
End With
Next
End With
End With
doc.body.appendchild (doc.createelement("br"))
'2d div
With doc.body.appendchild(doc.createelement("Strong"))
With .appendchild(doc.createelement("div"))
.ID = "monitor"
With .appendchild(doc.createelement("div"))
.ID = "in-mon"
With .appendchild(doc.createelement("div"))
.Style.TextAlign = "center"
With .appendchild(doc.createelement("iframe"))
.setattribute "allowfullscreen", """"""
.frameborder = 0
.Height = 360
.Width = "100%"
.marginheight = 0
.marginwidth = 0
.Name = "myframe"
.ID = "myframe"
.scrolling = "no"
.src = "#####"
End With
End With
End With
End With
End With
doc.body.RemoveChild (doc.body.getelementsbytagname("P")(0))
TextBox1 = doc.body.innerhtml
End Sub
Public Function htmlCodeIndenter(codehtml As Variant) As String
Dim code, elem, elements, i&, indent&, fin, indentmax&
With CreateObject("htmlfile")
.body.innerhtml = codehtml: .body.setattribute "indent", 0
Set elements = .body.getelementsbytagname("*")
For Each elem In elements: elem.setattribute "indent", 0: Next 'ajout de l'attribut "indent dans chaque elements
'l'enfant a 1 de plus que son parent dans l'attribut "indent"
For Each elem In elements
elem.setattribute "indent", elem.Parentelement.getattribute("indent") + 1:
indentmax = Application.Max(indentmax, Val(elem.getattribute("indent")))
Next
'ajout d'un textnode provisoire "indent" et son valueapres la fin de balise
For Each elem In elements
Set fin = .createTextNode("indent=""" & elem.getattribute("indent") & Chr(34))
elem.Parentelement.InsertBefore fin, elem.NextSibling
Next
'récuperation du code tel quel
code = .body.innerhtml
'ajoute les sauts de ligne a chaque balise
For Each elem In elements
code = Replace(code, "<", vbCrLf & "<")
Next
For i = 1 To 6: code = Replace(code, vbCrLf & vbCrLf, vbCrLf): Next 'on supprime les multi sauts de ligne
code = Split(code, vbCrLf) ' on coupe par les saut de ligne
'ajout du nombre de caractère d'indentation selon le val de indent
For i = 0 To UBound(code)
If InStr(1, code(i), "indent=""") Then
indent = Val(Split(code(i), "indent=""")(1))
code(i) = Application.Rept(vbTab, indent) & code(i)
End If
Next
'rejointure du code par saut de ligne
code = Join(code, vbCrLf)
'suppression de l'attribut indent et le textcode qui le constitue dans le outertext et / ou innertext
For i = 0 To indentmax
code = Replace(code, "indent=""" & i & Chr(34), "")
Next
htmlCodeIndenter = code
End With
End Function
