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

[Dudu2]

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 !).

 

[patricktoulon]

re j'ai compris ton principe mais tu ne simplifie la tache a personne là
dans la sub outlook et mes fonctions il y avais déjà tout
ton ne fonctionne pas chez tout le monde
chez moi ,chez mon voisin niet !

donc c'est pas bon

ce que je t'ai donné moi ça marche chez toi ca marche chez moi et chez mon voisin
ca fait 4 system et office différents (les deux miens,le tiens et celui de mon voisin)
là oui on peut penser que ça va fonctionner pour le plus grand nombre
bien que l'on soit jamais sur de rien

 

[patricktoulon]

le problème se situe c'est qu'a un moment le dossier est perdu donc pour mettre les images ben walouh!!

attention a ta méthode de travail
vide bien tes tempo et mémoire quand tu fais tes tests
des fois on a des surprises
ca fait un peu comme si VBA avait un prefectch

 

[Dudu2]

Voilà c'est fait car il faut rendre à César ce qui appartient à César:

 

[patricktoulon]

re
la version base64 avec publish est super rapide en tout cas
la tu a fait un sacré boulot de reprise de html
comme c'est du fichier unique tu pourrais lui mettre comme extension ".mht"


serais tu capable avec publish de récup uniquement le code table en nettoyant tout les vml img etc...
juste TABLE TR TD
et de transférer le style en head en style inline
ca serait intéressant parce que c'est quand même légèrement plus précis que moi

 

[Dudu2]

serais tu capable avec publish de récup uniquement le code table en nettoyant tout les vml img etc...
juste TABLE TR TD
et de transférer le style en head en style inline

J'ai passé pas mal de temps sur le HTML du Publish pour tenter de voir s'il y avait possibilité de bidouiller.
Hélas, ma connaissance du HTML est basique et je n'ai pas la capacité de comprendre ces trucs.

Si tu me donnes des directions, je peux tenter de coder une transformation de ce HTML par parsing selon tes instructions.

Il faudrait partir d'un fichier .htm de référence.

 

[patricktoulon]

re
il faudrait que je fasse une base de code
en attendant je cherche a netoyer le code de toute chose sauf les table car il en fait plusieurs
j'ai un resultat avec ce brouillon

Sub test()
    fichier$ = "C:\Users\patrick\Desktop\toto.htm"
    dossier$ = Replace(fichier, ".htm", "_fichiers")
    cde = GetCodeWithSrcRacourci(fichier)
   I = FreeFile: Open (Replace(fichier, ".htm", "2.htm")) For Output As #I: Print #I, cde: Close #I
 
    'SendSelectionWithOutlook cde, dossier, 2
End Sub


Function GetCodeWithSrcRacourci(fichier$)
    Dim docHtml As New HTMLDocument
    Dim laChaine As String, x
    x = FreeFile: Open fichier For Binary Access Read As #x: laChaine = String(LOF(x), " "): Get #x, , laChaine: Close #x
    docHtml.body.innerHTML = laChaine
    styl = "<style id=" & Split(Split(laChaine, "<style id=")(1), "</style>")(0) & "</style>"
   Set elements = docHtml.getElementsByTagName("*")
  
   For Each elem In docHtml.all
         If elem.tagName = "shape" Then elem.ParentNode.RemoveChild (elem)
        If elem.tagName = "AutoPict" Then elem.ParentNode.RemoveChild (elem)
        If elem.tagName = "imagedata" Then elem.ParentNode.RemoveChild (elem)
        If elem.tagName = "lock" Then elem.ParentNode.RemoveChild (elem)
        If elem.tagName = "!" Then elem.ParentNode.RemoveChild (elem)
        If elem.tagName = "SizeWithCells" Then elem.ParentNode.RemoveChild (elem)
        If elem.tagName = "CF" Then elem.ParentNode.RemoveChild (elem)
        If elem.tagName = "ClientData" Then elem.ParentNode.RemoveChild (elem)
     If LCase(elem.tagName) = "img" Then elem.ParentNode.RemoveChild (elem)
     'If LCase(elem.tagName) = "span" Then elem.ParentNode.RemoveChild (elem)
Next
    
    
    GetCodeWithSrcRacourci = "<html><head>" & styl & "</head>" & docHtml.body.outerHTML & "</html>"
End Function


Sub SendSelectionWithOutlook(cde, dossier, mode&)
    Dim code$, I&, FichierHTML$, DossierImages$, nom$, Rng As Range, Q, tim#
    Dim ob As Object, Adresse, OL As Object, OLmail As Object
    tim = Timer

    Set OL = CreateObject("Outlook.Application")
    Set OLmail = OL.CreateItem(0)    '0
    With OLmail
        '.From = CStr("guillaumepothier@hotmail.com")
        .To = "dudu@youmémélle.com"
        '.BodyFormat = olFormatHTML
        .Subject = "plage+shape" & Date
        .BodyFormat = 2
        If mode = 2 Then
            Q = Dir(dossier & "\*.png")
            If Q <> "" Then
                Do While Q <> ""
                    OLmail.Attachments.Add dossier & "\" & Q, 0, 0    ' les image sont invisibles dans les pieces jointes
                    OLmail.Attachments.Add dossier & "\" & Q    ' on les rattache une 2d fois si on veut qu'elles soient visibles et  télechargeables
                    Q = Dir
                Loop
            End If
        End If
        .HTMLBody = "bonjour salut<br>ci-joint le tableau des ventes du mois<br>" & cde & "<br>en vous souhaitant bonne reception<br>patrick à votre service"
        .display
        '.Save
        '.Send 'envoi automatique
    End With
    CommandBars("Cell").Reset
    CommandBars("List Range Popup").Reset
    MsgBox Format(Timer - tim, "#0.000 Sec")
End Sub

le joint le fichier et son dossier pubié

 

[patricktoulon]

bon après une bonne nuit de someil ce matin j'ai compris ou était le probleme
en fait avec publish si on laisse les image on se retrouve avec X elements("TABLE")
disons qu'il arrange au mieux
le problème après c'est que pour traiter les dim et positions ben c'est walouhh
j'ai testé en supprimant les drawingobjects avant de publier
surprise la table est seine le code est propre
conclusion mieux vaut exporter en htm sans les images et les remettre apres
c'est plus facile à gérer

 

[Dudu2]

Oui, cette approche me semble très appropriée.
Mais il faut replacer les images au bon endroit.

 

[patricktoulon]

re
ben en fait je surprime tout ce qui n'est pas une table (par code comme dans le brouillon que j'ai fait hiers soir
mais aujourd'hui je l'ai fait avec publich tout simplement en supprimant toute shapes dans le classeur temporaire
c'est incroyable la table est propre de touts element vml img shapetype et autre cochonnerie
la seul différence que j'ai avec ma methode par code c'est que le style est dans les balise style

petite démo comme ça vite fait en brouillon
colle ça dans ton classeur dans un module

'sub de test
Sub test()
    Dim Fichierhtml$, Dossier$, RnG As Range
    Fichierhtml = Environ("userprofile") & "\Desktop\titi.htm"
    'Dossier = Replace(fichier, ".htm", "_fichiers")'pour plus tard  recupérer les shapes
    Set RnG = [c4:i13]
    code = CreateHtmlPublish(RnG, Fichierhtml)
     SendSelectionWithOutlook CStr(code)
End Sub

' on crée le code html en le recuperant du publich
Function CreateHtmlPublish(RnG, fichier)
    Dim laChaine As String, x, code
    Application.DisplayAlerts = False: Application.ScreenUpdating = False
    Set TempWB = Workbooks.Add
    RnG.Copy TempWB.Sheets(1).[A1]    ' le (copy To Destination ) est plus rapide  que le (copy et sheet temp.paste......)
    With TempWB.Sheets(1)
        .DrawingObjects.Delete
        For I = 1 To RnG.Columns.Count
            .Columns(I).ColumnWidth = RnG.Columns(I).ColumnWidth
        Next
    End With
    DoEvents
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=fichier, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    DoEvents
    ActiveWorkbook.Close
    x = FreeFile: Open fichier For Binary Access Read As #x: laChaine = String(LOF(x), " "): Get #x, , laChaine: Close #x
    CreateHtmlPublish = laChaine
End Function


'la passerelle outlook diminuée pour l'exemple
Sub SendSelectionWithOutlook(cde$)
    Dim code$, I&, Fichierhtml$, DossierImages$, nom$, RnG As Range, Q, tim#
    Dim ob As Object, Adresse, OL As Object, OLmail As Object
    tim = Timer
    Set OL = CreateObject("Outlook.Application")
    Set OLmail = OL.CreateItem(0)    '0
    With OLmail
        '.From = CStr("guillaumepothier@hotmail.com")
        .To = "dudu@youmémélle.com"
        '.BodyFormat = olFormatHTML
        .Subject = "plage+shape" & Date
        .BodyFormat = 2

        .htmlbody = "bonjour salut<br>ci-joint le tableau des ventes du mois<br>" & cde & "<br>en vous souhaitant bonne reception<br>patrick à votre service"

        .display
        '.Save
        '.Send 'envoi automatique
    End With

End Sub

que ce soit sur outlook ou ff la table change pas de taille et elle est nette
et le code html alors un délice


reste plus qu'a ajouter une de nos deux fonctions shape to png
boucler sur les shapes de rng
et les placer dans le code
comment ?
ben le topleftcell donne l'address
par exemple C5 pour le smiley c'est donc la colonne 1 et ligne2 de la range donc elle va dans le TR(1 )et TD(0) de la table html car les indexs d'élément html sont en base 0

il va falloir que je réécrive la fonction putshaphtmloutlook dans ce sens
mais dans l'ensemble je suis convaincu que l'on peut avoir un resultat encore mieux que celui j'aovtiens avec mon code c'est beaucoup plus fin

 

[Dudu2]

Un peu naïvement j'essaie de partir du Publish SANS les objets et de replacer les images ensuite.
Je bute sur comment positionner une image en HTML. Bon faut chercher...

 

[Dudu2]

Bon j'ai réussi à faire ça à partir du Publish SANS l'image.

Je comprends pas bien pourquoi dans mon Tag:
<img width=93 height=41 align=left
src="RangeToHTMLBase64WithPublish_fichiers/Feuil5_31084_image001.png"
style='position:absolute;margin-left:86pt;margin-top:7.8pt'>
le width et le height sont plus grands d'un ratio 1.33 (96/72) par rapport à la Shape Excel et le left et le top sont d'un ration 1 par rapport à Excel. Mais bon, c'est déjà pas mal non ?

 

[Dudu2]

Bon, ben voilà pour Excel:

j'obtiens ça en HTML:

En fait c'est tout con ! Il faut Publier SANS les objets, récupérer les images des objets (j'utilise ma fonction pour ça) et ajouter les Tag Images avant la Table.

Je ne sais pas encore si ça convient à Outlook, mais sauf surprise ça devrait (?)

 

[patricktoulon]

re
ben pour les images sur outlook elle ressortiront en dessous
apres pour le web tu peux même les mettre après c'est pas un problème puisqu' elles sont en position absolute donc pas dans le flux elle ressortiront là ou tu les positionne
mais va y donne moi ton code

 

[Dudu2]

Voilà un code qui transforme un Range en fichier HTML (+ son répertoire Images éventuel)

Pour Base 64 & Outlook faudra que je remplace les SRC= des images soit en code Base64 soit en CID + Attachements (comme dans les anciens programmes). Reste à vérifier.

Edit: voir ci-dessous le fichier

 

[Dudu2]

ben pour les images sur outlook elle ressortiront en dessous
apres pour le web tu peux même les mettre après c'est pas un problème puisqu' elles sont en position absolute donc pas dans le flux elle ressortiront là ou tu les positionne

Pour l'instant je n'ai pas essayé.
Si les images passent dessous la table en Outlook, faudra corriger.
Là je m'absente. Je reprendrai ce soir après diner.

J'ai retiré du code inutile issu de copier / coller Base64.