XL 2016 VBA - Range to HTML incluant les objets de la feuille (boutons, images, ...)

Dudu2 · 14 Août 2022

Bonjour,

Je n'ai rien trouvé qui fonctionne pour convertir un Range en HTML qui inclurait tout ce qu'il y a dans le Range en question.

J'ai bien récupéré la fonction de Ron de Bruin omni-présente sur le Web qui fonctionne uniquement pour les valeurs de cellules et leurs formats, sauf pour les tableaux structurés qui ne sont pas en exclusivité dans le Range qui perdent alors leurs formats (qui n'en sont pas vraiment !).

Dudu2 · 18 Septembre 2022

Plusieurs solutions sont actuellement disponibles:

Les solutions de @patricktoulon dans cette ressource.
La solution de @Dudu2 dans le fichier joint pour chacune des situations:
- Créer un fichier .htm et son répertoire associé de fichiers images
- Créer un fichier .htm unique contenant les images codées en Base64
- Créer un mail Outlook

Dudu2 · 5 Septembre 2022

Ok pour Outlook

Mais je me demande si c'est normal d'avoir aussi les images en pièces jointes...?

Dudu2 · 5 Septembre 2022

Et c'est bon aussi pour IE y compris pour les 2 remarques précédentes.

Dudu2 · 5 Septembre 2022

A propos d'Outlook, dans ma Ressource qui utilise .Publish et où j'ai remplacé les =src fichiers par des =src cid je n'ai pas de pièces jointes. Mais bon ce n'est pas majeur.

patricktoulon · 5 Septembre 2022

re
ok donc ca marche
oui moi j'ai les images aussi en pièce jointe par ce que je les met deux fois regarde dans le code
la première fois il ne les prend pas il les mime dans les shapes VML
la secondes il les prend comme piece jointes

alors c'est pas du boulot de fou ça ?
et tout ça simplement avec du code

Dudu2 · 6 Septembre 2022

Et si tu ne les mets qu'une seule fois ?
Sinon, oui, c'est très fort ce que tu as fait. Perso je suis loin de seulement comprendre ton code de PutShapOnHtmlOutlook().

patricktoulon · 6 Septembre 2022

Re Bonjour @Dudu2
ben si tu les met qu'une fois tu les a pas en piece jointe

la fonction est simple en fait
il faut simplement connaitre le dom 1 c'est largement suffisant

allez je te la donne commentée

VB:

'****************************************************************************************************
Function PutShapOnHtmlOutlookX(CdeHTML$, RnG As Range, Optional ByVal DossierImage$ = "")
'Function d'ajout des images dans le code html d'une cellule TD html en utilisant 2 balises "PRE"
'retransformé en en code shape:VML pour outlook
'patricktoulon (2022)
    Dim DcO As New HTMLDocument, shap As Object, cel As Range, TD, VrecT, VfilL, Addr$, dossier
    Dim pres, A&, bal$, deb$, fin$, code$, ImG, Li
    'on a crée un htmldocument
    'on lui met le code  de la table dont les balises TD ont comme "id" l'address de la cellule correspondante
    DcO.body.innerhtml = CdeHTML
    'on boucle sur toute les shapes  de la feuille
    For Each shap In RnG.Parent.DrawingObjects
        ' on determine la range contenant la shap
        Set cel = shap.TopLeftCell.MergeArea
        ' on determine l'adress sans les "$"
        Addr = cel.Address(0, 0)
        'si  il y a intersection de cette range avec RNG
        If Not Intersect(shap.TopLeftCell, RnG) Is Nothing Then
            ' alors  on cible la cellule html correspondante
            ' et on lui ajoute l'atribut position à relative dans l'attribut "STYLE"
            Set TD = DcO.getelementbyid(Addr): TD.Style.Position = "relative"


            ' on crée une balise "LI"( elle est provisoire)
            Set Li = DcO.createElement("LI")
            ' on crée aussi la balise image (ca c'est evident)
            Set ImG = DcO.createElement("IMG")
            'la balise image devien enfant de la balise "LI"
            Li.appendchild (ImG)

            ' on crée une balise temporaire "PRE"
            Set VrecT = DcO.createElement("pre")
            ' on lui ajoute les attribut pour une shapes VML de microsoft
            VrecT.setattribute "xmlns:v", "urn:schemas-microsoft-com:vml"
            VrecT.setattribute "fill", "true"
            VrecT.setattribute "stroke", "false"
            ' on lui met un attribut bal avec le type que ca devrait etre )
            VrecT.setattribute "bal", "v:rect"

            ' la on lui met le style css (left top width,height)
            With VrecT.Style
                .Position = "absolute"
                .Left = Int(Int(shap.Left) - cel.Left - 1) & "pt"
                .Top = Int(shap.Top - cel.Top) & "pt"
                .Width = Replace(shap.Width, ",", ".") & "pt"
                .Height = Replace(shap.Height * 1.1, ",", ".") & "pt"
            End With

            'on met le style  à l'image aussi (position absolute forcement et le left , top ,width , height)
            With ImG.Style
                .Position = "absolute"
                .Left = Int(Int(shap.Left) - cel.Left - 1) & "pt"
                .Top = Int(shap.Top - cel.Top) & "pt"
                .Width = Replace(shap.Width * 1.05, ",", ".") & "pt"
                .Height = Replace(shap.Height * 1.07, ",", ".") & "pt"
            End With
            ' on ajoute le src  ca je vais pas l'expliquer tu connais
            ImG.src = Mid(DossierImage, InStrRev(DossierImage, "\") + 1) & "\" & Replace(shap.Name, " ", "_") & ".png"

            'on crée une seconde balise PRE  et on fait pareil que pour la "vrect"
            ' on lui met comme attribut  le type qu'elle devrait etre
            Set VfilL = DcO.createElement("pre")
            'on lui met ses attributs
            VfilL.setattribute "type", "frame"
            VfilL.setattribute "bal", "v:fill"
            'bien entendu on ajoute le src
            ' et comme c'est pour outlook  il n'y a pas de chemin c'est directement le nom de l'image
            ' attention outlook ne suporte pas les espace dans le nom des images
            VfilL.setattribute "src", Replace(shap.Name, " ", "_") & ".png"
            'la 2d balise PRE devient donc l'enfant de la premiere balise PRE
            VrecT.appendchild (VfilL)

            'la 1ere  balise PRE contenant la 2d devient enfant de la balise TD( cellule html) precedement repéreée
            TD.appendchild (VrecT)
            ' la balise "LI" devien a son tour enfant de la de la balise TD( cellule html) precedement repéreée
            TD.appendchild (Li)
        End If

    Next


  ' voila a ce niveau de la fonction , on a dans les cellules html qui ont des images    ceci

'*********************************************************************************************************
     '<TD style="BORDER-BOTTOM: #dcdcc8 1px solid; POSITION: relative; TEXT-ALIGN: left; BORDER-LEFT: #dcdcc8 1px solid; BACKGROUND-COLOR: #4472c4; WIDTH: 60pt; MAX-WIDTH: 61pt; WORD-WRAP: break-word; HEIGHT: 14pt; MAX-HEIGHT: 14pt; WORD-BREAK: break-all; BORDER-TOP: #dcdcc8 1px solid; BORDER-RIGHT: #dcdcc8 1px solid" id=C4 vAlign=bottom>
    '    <FONT style="MARGIN: 0px 2px" color=#ffffff face=Calibri>T1 </FONT>
    '    <PRE style="POSITION: absolute; WIDTH: 30.75pt; HEIGHT: 25.575pt; TOP: 2pt; LEFT: 8pt" xmlns:v="urn:schemas-microsoft-com:vml" fill="true" stroke="false" bal="v:rect">
    '        <PRE bal="v:fill" type="frame" src="Smiley_Face_1.png">
    '        </PRE>'
    '    </PRE>
    '    <LI>
    '        <IMG style="POSITION: absolute; WIDTH: 32.287pt; HEIGHT: 24.877pt; TOP: 2pt; LEFT: 8pt" src="images_table_C4_I13\Smiley_Face_1.png">'
    '    </LI>
    '</TD>
'*********************************************************************************************************
    ' c'est beau non?  :)

    ' on collectionne les balise pre
    Set pres = DcO.getelementsbytagname("PRE")
    'boucle sur toute les balise pre
    'en arriere ( c'est comme pour beaucoup de chose en vba il faut boucler en arriere  sinon le count est faussé)
    For A = pres.Length - 1 To 0 Step -1
        ' on repere l'atribut bal (il y a dedans le type qu'elle devarit etre
        bal = pres(A).getattribute("bal")
        'ben on remplace  le tag de la balise pre par son attribut bal
        If InStr(pres(A).outerhtml, "<pre") > 0 Then
            pres(A).outerhtml = Replace(Replace(pres(A).outerhtml, "<pre", "<" & bal), "pre>", vbCrLf & bal & ">")
        Else
            pres(A).outerhtml = Replace(Replace(pres(A).outerhtml, "<PRE", "<" & bal), "PRE>", vbCrLf & bal & ">")
        End If
    Next

  ' voila a ce niveau de la fonction  on a ceci !!!!!!!!!!!!!

'*********************************************************************************************************
      '<TD style="BORDER-BOTTOM: #dcdcc8 1px solid; POSITION: relative; TEXT-ALIGN: left; BORDER-LEFT: #dcdcc8 1px solid; WIDTH: 60pt; MAX-WIDTH: 61pt; WORD-WRAP: break-word; HEIGHT: 14pt; MAX-HEIGHT: 14pt; WORD-BREAK: break-all; BORDER-TOP: #dcdcc8 1px solid; BORDER-RIGHT: #dcdcc8 1px solid" id=F4 vAlign=bottom>
    '   <FONT style="MARGIN: 0px 2px" face=Calibri></FONT>
    '   <v:rect style="POSITION: absolute; WIDTH: 215.999pt; HEIGHT: 157.575pt; TOP: 3pt; LEFT: 14pt" xmlns:v="urn:schemas-microsoft-com:vml" fill="true" stroke="false" bal="v:rect">
    '       <v:fill bal="v:fill" type="frame" src="Picture_12.png">
    '       </ v:fill>
    '       </v:fill>
    '   </ v:rect>
    '   </v:rect>
    '   <LI>
    '       <IMG style="POSITION: absolute; WIDTH: 226.799pt; HEIGHT: 153.277pt; TOP: 3pt; LEFT: 14pt" src="images_table_C4_I13\Picture_12.png">
    '   </LI>
    '</TD>
'*********************************************************************************************************
    ' ben maintenant il faut  mettre les condition si outlook et else
    ' et faire les quelques replacement    des impuretés du code
    deb = "<!--[if mso]>": fin = "<![endif]-->"
    code = DcO.body.innerhtml
    code = Replace(code, "</ v:rect>", "")
    code = Replace(code, "</ v:fill>", "")
    code = Replace(code, "<v:rect", vbCrLf & deb & vbCrLf & "<v:rect")
    code = Replace(code, "</v:rect>", "</v:rect>" & vbCrLf & fin)
    code = Replace(code, "</v:fill>", vbCrLf & "</v:fill>")
    code = Replace(code, "<?xml:namespace prefix = v />", "")
    code = Replace(code, "bal=""v:rect""", "")
    code = Replace(code, "bal=""v:fill""", "")

    If InStr(1, code, "<li>") > 1 Then
        code = Replace(code, "<li>", "<!--[if !mso]><!-- -->" & vbCrLf)
        code = Replace(code, "</li>", vbCrLf & "<!--<![endif]-->" & vbCrLf)
    Else
        code = Replace(code, "<LI>", "<!--[if !mso]><!-- -->" & vbCrLf)
        code = Replace(code, "</LI>", vbCrLf & "<!--<![endif]-->" & vbCrLf)
    End If

    ' terminé maintenant on a CA!!! dans les CELLULES HTML!!!
 
'*********************************************************************************************************
 '<TD style="BORDER-BOTTOM: #dcdcc8 1px solid; POSITION: relative; TEXT-ALIGN: left; BORDER-LEFT: #dcdcc8 1px solid; BACKGROUND-COLOR: #4472c4; WIDTH: 60pt; MAX-WIDTH: 61pt; WORD-WRAP: break-word; HEIGHT: 14pt; MAX-HEIGHT: 14pt; WORD-BREAK: break-all; BORDER-TOP: #dcdcc8 1px solid; BORDER-RIGHT: #dcdcc8 1px solid" id=C4 vAlign=bottom><FONT style="MARGIN: 0px 2px" color=#ffffff face=Calibri>T1 </FONT>
    '   <!--[if mso]>
    '       <v:rect style="POSITION: absolute; WIDTH: 30.75pt; HEIGHT: 25.575pt; TOP: 2pt; LEFT: 8pt" xmlns:v="urn:schemas-microsoft-com:vml" fill="true" stroke="false" >
    '           <v:fill  type="frame" src="Smiley_Face_1.png">
    '           </v:fill>
    '       </v:rect>
    '   <![endif]-->
    '   <!--[if !mso]><!-- -->
    '       <IMG style="POSITION: absolute; WIDTH: 32.287pt; HEIGHT: 24.877pt; TOP: 2pt; LEFT: 8pt" src="images_table_C4_I13\Smiley_Face_1.png">
    '   <!--<![endif]-->
    '</TD>
'*********************************************************************************************************

    PutShapOnHtmlOutlook = code
    Set DcO = Nothing
End Function
'***************************************************************************

Dudu2 · 6 Septembre 2022

C'est sympa merci

Dudu2 · 6 Septembre 2022

Pourquoi tu fais toutes ces manips pour créer les fichiers images ?
Ce serait plus rapide en passant par un Chart.Export non ?

patricktoulon · 6 Septembre 2022

re
chart export ne gère pas les transparence

Dudu2 · 6 Septembre 2022

Ah oui, c'est vrai !

patricktoulon · 6 Septembre 2022

encore que !!!
je sais enlever une couleur sur une image d'une feuille en rendant une couleur précise transparente
peut etre que l'image collé dans le chart pourrait l’être je ne sais pas je n'ais jamais testé

patricktoulon · 7 Septembre 2022

Salut @Dudu2
allez tu en a encore la primeur
voici la nouvelle version se shapes to png file
V3.0
plus propre, plus rapide
deux options

toutes les shapes de la feuille
toutes les shapes qui sont a l’intérieur du périmetre d'un range

enjoy!

Dudu2 · 8 Septembre 2022

Bonjour @patricktoulon,
Trop fort ! Je ne savais même pas que ces instructions existaient.
Bravo pour l'exploit !

patricktoulon · 8 Septembre 2022

A nous deux on va finir par faire quelque chose de propre

mes conclusions sur la methode publier en html:

pourquoi pour moi l'export en html n'est pas une solution viable pour outlook

raison 1:
l'export lui même du html(son code) est différent chez toi et chez moi et sans doute ailleurs aussi
donc pour faire un code générique pour tous c'est compliqué

raison 2:
les images et shapes sont bien exportées mais en double
et les indexs dans le dossier ne sont pas les memes que l'ordre dans le quel elles ont été créées dans la feuille
si bien que pour faire une cohérence ben WALOUH!!!

raison 3:
tout simplement un code imbuvable à retravailler (des tables imbriquées un format (shapetype/V)et j'en passe ) en plus de la raison 1. c'est compliqué a maîtriser

raison 4:
c'est légèrement plus long chez moi que la méthode simple que j'utilise qui consiste a tout créer
bon certe sur de plus grande plage je serais loin derriere

et enfin
raison 5
qui est en elle même ma conclusion
c'est qu'avec ma méthode tu gère tout

alors certes il faut bien penser que ça evolue et qu'il donc fort probable que je soit obligé de revenir dessus avec des mises a jour en fonction de cette evolution
mais les principaux code resteront génériques(compatibles pour tous)
mais c'est marrant non ?

Dudu2 · 8 Septembre 2022

A nous deux on va finir par faire quelque chose de propre

Ouais, enfin surtout à toi tout seul sur ce code autonome.
J'attends tes publications pour adapter le post Solution à ce sujet.

XL 2016 VBA - Range to HTML incluant les objets de la feuille (boutons, images, ...)

Dudu2

XLDnaute Barbatruc

Pièces jointes

Dudu2

Dudu2

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Pièces jointes

Dudu2

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Discussions similaires