XL 2019 Remplacer une partie du code HTML par des lignes provenant d'un fichier Excel.

eCHO

XLDnaute Junior
Bonjour,

J'ai un code HTML qui affiche des vidéos sur un site web. À chaque fois, je dois remplacer les "#####" par les liens des vidéos qui se trouvent dans la ligne B2,C2,D2.... d'un fichier Excel. Je voudrais savoir s'il est possible de le faire avec VBA.

HTML:
<div style="text-align: center;">
          <strong><input onclick="myframe.location.href='#####'" type="button" value="video 1" />
                <input onclick="myframe.location.href='#####'" type="button" value="video 2" />
                <input onclick="myframe.location.href='#####'" type="button" value="video 3" />
                <input onclick="myframe.location.href='#####'" type="button" value="video 4" />
              </strong></div>
<strong>
</strong>
<br />
<div id="monitor">
<div id="in-mon">
<div style="text-align: center;">
<iframe allowfullscreen="" frameborder="0" height="360" marginheight="0" marginwidth="0" name="myframe" scrolling="no" src="#####" width="100%">
</iframe><strong>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;</strong></div>

Merci infiniment pour votre aide.
 

Pièces jointes

  • site web.xlsm
    15 KB · Affichages: 4
Solution
bonjour
dans l'event de ton bouton actualiser tu met

VB:
Private Sub CommandButton2_Click()
    Dim doc As Object
    Set r = Range("Tableau1[#all]")

    ligne = 2 'adapter la ligne si vous voulez changer de ligne du tableau1

    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 "onclick=""myframe.location.href='" & r.Cells(ligne, i).Value & "'"""
                    .setattribute "type", "button"
                    .onclick =...

patricktoulon

XLDnaute Barbatruc
bonjour
dans l'event de ton bouton actualiser tu met

VB:
Private Sub CommandButton2_Click()
    Dim doc As Object
    Set r = Range("Tableau1[#all]")

    ligne = 2 'adapter la ligne si vous voulez changer de ligne du tableau1

    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 "onclick=""myframe.location.href='" & r.Cells(ligne, i).Value & "'"""
                    .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("stromg"))
        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"
                        .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
je peux tenter une indentation du code html si tu veux

et enfin dans l'events du bouton copie


VB:
Private Sub CommandButton1_Click()
 With New DataObject: .SetText (TextBox1.Text): .PutInClipboard: End With
End Sub
 

patricktoulon

XLDnaute Barbatruc
re
c'est pas encore bien au point mais déjà on a une indentation cohérente
il faut que je me débrouille pour indenter le fins de balise
mais on a quand une vue plus nette de l’arborescence
demo.gif
 

Pièces jointes

  • site web.xlsm
    25.1 KB · Affichages: 3

patricktoulon

XLDnaute Barbatruc
ha ça donne pas le même résultat chez toi visiblement
c'est étonnant ,pourtant tu vois bien que dans ma capture animé les liens y sont
je regarderais demain en fin d'après midi quand je rentre
pour ce soir ça va
peut être a tu eu la mise ajour W10 qui pétarde les librairie de IE (ca plus d'un an que Microsoft l'a annoncé )
et là on va avoir un soucis
j'ai bien peur si c'est le cas , il faudra se contenter de faire tout ça en string
ca va être rigolo
perso j'ai réinstaller IE 11 avant derniere version
et j'ai ré engistré les dlls
j'ai donc toujours IE dispo
 

patricktoulon

XLDnaute Barbatruc
re
testé sur w7 office 2007 et W10 office 2013

VB:
'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


demo.gif
 

Pièces jointes

  • site web.xlsm
    26.7 KB · Affichages: 4

patricktoulon

XLDnaute Barbatruc
re
comme IE n'est plus pris en natif dans w 10 et 11 et les office version 64
ajoute la references html "Micorsoft object html library"

sinon c'est que vraiment tu ne peux plus te servir des librairies html
et l je ne vois que travailler en string mais ça ne sera jamais sur et propre et 100% et fini l'indentation aussi
autant abandonner tout de suite un tel projet
c'est comme vouloir faire une soupe sans les légumes et sans casserole
 

eCHO

XLDnaute Junior
Merci pour votre aide, j'apprécie beaucoup vos efforts. Même si une partie ne fonctionne pas à cause des dernières mises à jour de Windows et Office, j'ai appris des choses qui me seront utiles dans les futurs projets.