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

 

[Dudu2]

Je m'attendais un peu à ton retour.
C'est le même problème que tu as eu avec ma fonction de création des fichiers images que j'ai gardée telle quelle. Je ne comprends pas du tout du tout ce qui fait que ça ne marche pas chez toi.

 

[patricktoulon]

la version 5.1 que j'ai faite spécialement pour toi fonctionne chez moi et chez toi
c'est mon code html et la fonction utilise ton principe du publissh des shapes
si tes fichiers ne fonctionnent pas de la même manière chez toi et chez moi c'est que tu t' es planté quelque part

je commence a comprendre que tu a une config bien personnelle et que tu code en fonction

c'est pas bon pour une ressource public
il faut coder universelle si tu veux partager
bref c'est un carnage chez moi rien ne fonctionne ca me mine un peu a vrai dire âpres tout ce temps passé dessus
alors je vais essayer de comprendre tes codes et voir ou la bille coince

 

[Dudu2]

je commence a comprendre que tu a une config bien personnelle et que tu code en fonction

Je ne crois pas car j'ai fait pas mal (des dizaines) de macros, et des bien complexes, pour plein de gens et je n'ai jamais eu de retour sur des trucs qui marchaient chez moi et pas chez eux.

la version 5.1 que j'ai faite spécialement pour toi fonctionne chez moi et chez toi

Oui, tu l'as dit, mais cette version je ne l'ai pas vue publiée ici ni sur les ressources.

il faut coder universelle si tu veux partager

Il n'y a absolument RIEN de spécifique dans le code de cette fonction.
La seule chose susceptible de varier est le suffixe du répertoire utilisé par Publish qui est "_fichiers" en français que j'ai placé en constante et que je suppose "_files" en anglais. Si tu utilises une version anglaise alors ça s'explique.
Sinon je ne vois pas.

 

[Dudu2]

D'ailleurs je vais modifier ça pour que le code trouve tout seul ce suffixe quelque soit la langue d'Office.

 

[patricktoulon]

re
bon alors
j'ouvre ton fichier
j'ajoute un module vierge "module_Tests_outlook
je remet juste ma sub d'apel et ma sub d'interface outlook du fichier 5.1
dans la sub d'interface je change le nom de la fonction shape/pngfile puisque tu a mit la tienne

ca donne ca

'**********************************************************************************
' __        ___  ___   .  ___         _____  ___             ___
'|__|  /\    |  |   |  | |     | /      |   |   | |   | |   |   | |\  |
'|    /__\   |  |---   | |     |/\      |   |   | |   | |   |   | | \ |
'|   /    \  |  |   \  | |___  |  \     |   |___| |___| |__ |___| |  \|

'***********************************************************************************
''***********************************************************************************
'                   FONCTION RANGE TO HTML ET OUTLOOK SHAPES VML VERSION 4.8 2022
'           MODULE DE TEST POUR LA FONCTION RANGE TO HTML VERSION 4.8 2022
'Function pour créer le code html d'une plage de cellule avec ou sans les images et shapes pour outlook
'Version du module de test 3.0 2022
'Date Version:11/09/2022
'Auteur: patricktoulon sur exceldownloads
'le code html obtenu contient les deux formats d'embbed pour les images (html web et outlook)

'************************************************************************************
Option Explicit

'                                TESTS  POUR OUTLOOK

'*******************************************************************************************************************
Sub testdemoi()
SendSelectionWithOutlook Feuil1.[c4:i13], 2, False
End Sub




Sub SendSelectionWithOutlook(addr, mode&, Optional DisplayGriLine As Boolean = True)
    Dim code$, i&, FichierHTML$, DossierImages$, nom$, Rng As Range, Q, tim#
    Dim ob As Object, Adresse, OL As Object, OLmail As Object
    tim = Timer
    If TypeName(addr) = "String" Then Set Rng = ActiveSheet.Range(addr) Else Set Rng = addr
    nom = "imgTable_" & Replace(Rng.Address(0, 0), ":", "-")
    FichierHTML = ThisWorkbook.Path & "\" & nom & ".html"
    spaceMargin = "  "
    code = CreateTableBase2(Rng, DisplayGriLine)
    If mode = 2 Then
        DossierImages$ = ThisWorkbook.Path & "\" & nom
        ShapesInRangeToImageFiles Rng, DossierImages
        code = PutShapOnHtmlOutlook(code, Rng, DossierImages)    'on ajoute les images avec (src du fichier) dans le code html de la table
    End If
    'i = FreeFile: Open FichierHTML For Output As #i: Print #i, code: Close #i
    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(DossierImages & "\*.png")
            If Q <> "" Then
                Do While Q <> ""
                    OLmail.Attachments.Add DossierImages & "\" & Q, 0, 0    ' les image sont invisibles dans les pieces jointes
                    OLmail.Attachments.Add DossierImages & "\" & 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>" & code & "<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

je ne me sert donc pas de tes modules
Module_RangeToHTMLOutlookPatric
Module_Test

ALLEZ ON TEST !!

voilà conclusion tes modules d’interface ne fonctionne pas
et là tu peux rien dire on vois bien que c'est ton fichier
j'ai juste remis ma sub d'appel et sub interface outlook c'est tout
Ah!!!t oui juste changer pour ta version d’exporter d'image
de toute façon j'ai testé les deux et ca marche
aussi bien avec DrawingObjects_To_Png_File que ShapesInRangeToImageFiles

la conclusion elle est claire comme de l'eau de roche
c'est bien tes modules d'interface qui sont mal conçus en tout cas il y a une carabistouille quelque part

 

[patricktoulon]

re
je viens de tester chez mon pot le voisin avec W10 et excel 2016
ca plante au même endroit et la même erreur le même message
il va me maudire depuis hiers j'arrete pas de lui demander de tester des trucs

 

[patricktoulon]

bon alors je cherche un peu et finalement c’était pas loin
regarde ton code
et dis moi malgré que j'en ai rajouté pour verifier si il ne manque pas quelque chose
ps pour info le travail de creation html et autres je le fait avant car outlook prend beaucoup de memoire a l 'ouverture j'ai juste modifié ca et mi l’écriture du code dans un fichier pour l'inspecter
bref toujours pas d'image dans le mail
CA TE parait pas évident le pourquoi ????
c'est énorme tellement c'est petit

Option Explicit

Sub Test()
    Dim ObjOutlook As Object
    Dim ObjOutlookMail As Object
    Dim ErrNumber As Long
    Dim HtmlX
    Dim I&
    '---------------------------
    'Création des Objets Outlook
    '---------------------------
    On Error Resume Next
    Set ObjOutlook = CreateObject("Outlook.Application")
    Set ObjOutlookMail = ObjOutlook.CreateItem(0)
    ErrNumber = Err.Number
    On Error GoTo 0
    
    If ErrNumber <> 0 Then
        MsgBox "Fonction MailOutlook: Erreur " & ErrNumber & " lors de la création des objets Outlook"
        Exit Sub
    End If
    HtmlX = "Bonjour<BR>" & _
                    "Voici le RangeToHTMLOutlookWithPatrickCode([" & [B1].Value & "]) " & _
                    IIf(UCase([B2].Value) = "OUI", "avec", "sans") & " ses objets" & _
                    IIf(UCase([B3].Value) = "OUI", "avec", "sans") & " les Gridlines" & _
                    RangeToHTMLOutlookWithPatrickCode(ObjOutlookMail, Range([B1].Value), _
                                                      IncludeObjects:=IIf(UCase([B2].Value) = "OUI", True, False), _
                                                      DisplayGridLines:=IIf(UCase([B3].Value) = "OUI", True, False)) & _
                    "Cordialement"
    I = FreeFile: Open Environ("userprofile") & "\desktop\codepatdudu.html" For Output As #I: Print #I, HtmlX: Close #I
    '--------------------------------------------
    'Valorisation des éléments de l'objet Outlook
    '--------------------------------------------
    With ObjOutlookMail
        'Set .SendUsingAccount = ObjOutlook.Session.Accounts.Item(1)
        .To = "addressee@domain.com"
        .Subject = "Envoi de mail Outlook avec RangeToHTMLOutlookWithPatrickCode([" & [B1].Value & "]) " & _
                   IIf(UCase([B2].Value) = "OUI", "avec", "sans") & " ses objets " & _
                   IIf(UCase([B3].Value) = "OUI", "avec", "sans") & " les Gridlines"
        .BodyFormat = 2
        .htmlbody = HtmlX
    End With
    
    'Display du mail
    With ObjOutlookMail
        .display
    End With
End Sub

a chaque fois tu me fait courir pour rien

 

[Dudu2]

@patricktoulon, tant que tu feras des paraboles et du gras triple taille, je ne comprendrai pas.
Si tu veux expliquer quelque chose, explique-le.

 

[patricktoulon]

ben c'est simple
comment veux tu avoir les images si tu attach pas les images
alors oui dans le code il y a bien les vrect et img avec le bon src sauf que tu n'envoie pas les images

le problème c'est que dans les temp je ne les trouve pas
je sais pas ou t'envoie le dossier de récupération
si tu me dis que ca fonctionnait chez toi on marche sur la tête là
alors comme je sais pas ou sont les images je te dis juste ou il faut que tu ajoute le code d'attach

Option Explicit

Sub Test()
    Dim ObjOutlook As Object
    Dim ObjOutlookMail As Object
    Dim ErrNumber As Long
    Dim HtmlX
    Dim I&
    '---------------------------
    'Création des Objets Outlook
    '---------------------------
    On Error Resume Next
    Set ObjOutlook = CreateObject("Outlook.Application")
    Set ObjOutlookMail = ObjOutlook.CreateItem(0)
    ErrNumber = Err.Number
    On Error GoTo 0
   
    If ErrNumber <> 0 Then
        MsgBox "Fonction MailOutlook: Erreur " & ErrNumber & " lors de la création des objets Outlook"
        Exit Sub
    End If
    HtmlX = "Bonjour<BR>" & _
                    "Voici le RangeToHTMLOutlookWithPatrickCode([" & [B1].Value & "]) " & _
                    IIf(UCase([B2].Value) = "OUI", "avec", "sans") & " ses objets" & _
                    IIf(UCase([B3].Value) = "OUI", "avec", "sans") & " les Gridlines" & _
                    RangeToHTMLOutlookWithPatrickCode(ObjOutlookMail, Range([B1].Value), _
                                                      IncludeObjects:=IIf(UCase([B2].Value) = "OUI", True, False), _
                                                      DisplayGridLines:=IIf(UCase([B3].Value) = "OUI", True, False)) & _
                    "Cordialement"
    I = FreeFile: Open Environ("userprofile") & "\desktop\codepatdudu.html" For Output As #I: Print #I, HtmlX: Close #I
    '--------------------------------------------
    'Valorisation des éléments de l'objet Outlook
    '--------------------------------------------
    With ObjOutlookMail
        'Set .SendUsingAccount = ObjOutlook.Session.Accounts.Item(1)
        .To = "addressee@domain.com"
        .Subject = "Envoi de mail Outlook avec RangeToHTMLOutlookWithPatrickCode([" & [B1].Value & "]) " & _
                   IIf(UCase([B2].Value) = "OUI", "avec", "sans") & " ses objets " & _
                   IIf(UCase([B3].Value) = "OUI", "avec", "sans") & " les Gridlines"
        .BodyFormat = 2
        .htmlbody = HtmlX
 
   '!!!!!!ICI DANS UNE BOUCLE SUR DOSSIER AJOUTE TES IMAGES '
 'et vire ce double with  il sert a rien
 
   End With
   
    'Display du mail
    With ObjOutlookMail
        .display
    End With
End Sub

 

[Dudu2]

Non, ce n'est pas ça, les images sont attachées dans la fonction RangeToHTMLOutlookWithPatrickCode().
Sinon comment obtiendrai-je sur mon PC ce résultat.

Je sais bien que tu penses que mon PC est très particulier, mais je ne crois pas que ses particularités lui donnent le pouvoir magique de charger les images dans le HTML.

Dans quelle langue est ton Office ?

 

[Dudu2]

Voilà, j'ai modifié ma fonction de génération des images pour qu'elle soit indépendante du langage.

En effet, pour le nom du répertoire des images, Publish prend le nom du fichier .htm et ajoute "_fichiers".
On peut supposer qu'en anglais il ajoutera "_files", en polonais "_akta", en islandais "_skrár", etc...
J'avais pris le parti français en hard-codant "_fichiers" par facilité. Mais la facilité n'est pas le chemin du succès (proverbe chinois de la période Ming).

Les fichiers concernés du post #342 ont été modifiés en conséquence.

J'ai aussi essayé ces fichiers sur mon laptop de voyage et ils fonctionnent.

 

[patricktoulon]

je l'ai vu cette fonction

en fait pour etre honete tu complique trop les choses
passer par 36 passerelles tu es sur que tu aura top ou tard une couillette dans le potage

j'ai fait une
fonction code html
une fonction pour ajouter les tg vrect et img avec src
ma fonction ou la tienne pour récup les image
en plus je te les ai argumentés pour que des la sub test tu puisse décider avec image ou pas et gridline ou pas
c'est interminable on passe d'un module a l'autre pour suivre le cheminement de ton interface

en tout cas je n'ai pas approfondi sur ta méthode avec tes deux autres fichiers
mais là avec ma méthode tu l'a rendu plus compliqué qu'autre chose

bref la preuve est fait si je remet ma sub à moi sur 3 pc différents ici avec windows et office différent ça marche

non vraiment tu t'est planté complètement sur ce coup là
je pense que tu a essayé d'adapter la conception des deux autres fichier a la mienne alors que j'avais déjà tout fait et tout prévu tout du moins dans le contexte simple qui consiste a appeler outlook avec un code html avec images ou pas piloter sub d'appel
en fait tu a ajouté des!! interfaces a mon interface

si tu dois proposer un fichier avec mon code propose le simplement
par ce que celui qui va regarder dans les modules il va croire que c'est moi qui ai fait ça(ça me gène un peu) alors que pas du tout

pour être honnête je ne garde que ta fonction ShapesInRangeToImageFiles( elle fonctionne a merveille)
j'ai jeté tout le reste (désolé)
et j'ai mis juste ma sub de tests
rien ne t’empêche de retravailler la sub interface SendSelectionWithOutlook
l'argumenter avec le destinataire et autres
mais par pitié oublie tes passerelles de fonctions en fonctions ca ne marche pas
en tout ca avec mon code
et la oui on peut parler d'interface
autant lors de notre précédent exercice sur le fso tu avais été formidable autant là
ben je suis un peu déçu

ton fichier nettoyé
lance la sub de test
c'est ça un interface

alors c'est vrai je suis un peu dur sur mon jugement mais là tu touche a mon bébé
et tu en est témoins il y a plus de 30 heures de travail et d'adaptation
je peux pas te laisser faire ça

maintenant je vais essayer de comprendre les deux autres

 

[patricktoulon]

Voilà, j'ai modifié ma fonction de génération des images pour qu'elle soit indépendante du langage.

En effet, pour le nom du répertoire des images, Publish prend le nom du fichier .htm et ajoute "_fichiers".
On peut supposer qu'en anglais il ajoutera "_files", en polonais "_akta", en islandais "_skrár", etc...

Les fichiers concernés du post #342 ont été modifiés en conséquence.

J'ai aussi essayé ces fichiers sur mon laptop de voyage et ils fonctionnent.

non non moi c'est bien "_fichiers" le suffixe

 

[Dudu2]

c'est interminable on passe d'un module a l'autre pour suivre le cheminement de ton interface

L'approche que j'ai prise est celle de la simplicité d'utilisation pour quelqu'un qui veut s'en servir.
Tu veux générer le HTML pour Outlook ?
Tu appelles une seule fonction: RangeToHTMLOutlookWithPatrickCode() avec les paramètres.

Function RangeToHTMLOutlookWithPatrickCode(ObjOutlookMail As Object, _
                                           Rng As Range, _
                                           Optional ByVal IncludeObjects As Boolean = False, _
                                           Optional ByVal DisplayGridLines As Boolean = False) As String

Pas besoin d'appeler 36 trucs dont il faut d'abord essayer de comprendre à quoi ça sert.

De toutes façons, tu publieras ta version de la chose dans les ressources, donc tout le monde est content.

 

[Dudu2]

non non moi c'est bien "_fichiers" le suffixe

Bon, ben si ça marche pas chez toi, je ne peux plus rien faire.
A moins que j'aie 2 PCs Windows 10 / Offices 2016 qui ont tous les 2 des particularités (alors que tout est standard dans ma config) je ne vois pas. Laisse tomber, ce n'est pas si important.

Lorsque tu auras publié ta ressource je mettrai un lien, comme ça les gens pourront y aller directement s'ils passent par ici.