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
bon ben je met un espace html et le tour est joué
v4.8
1°espace margin-left ok pour outlook
2° dimensions shapes modifiées au plus proche pour outlook et html web

original Excel

SUR FICHIER WEB

DANS OUTLOOK

je reprendrais la v 4.9 quand j'aurais trouver une vrai bonne solution pour determiner les cellule à masquer (displayGridline false)

 

[Dudu2]

je reprendrais la v 4.9 quand j'aurais trouver une vrai bonne solution pour determiner les cellule à masquer (displayGridline false)

Si ça pose trop de difficultés, on peut s'en passer. A toi de voir.

 

[patricktoulon]

re
ben c'est surtout que je n'ai pas encore trouver le moyen de coder la logique du principe
dans la v 4.9 beta c'etait un test basé sur l'absence de données mais si comme dans mon exemple en feuil 2 les cellules sont bordurées mais vides , elle disparaissent dans le html
c'est donc pas la seule propriété a prendre en compte de qui représente un petit moulin a faire
et je veux surtout pas allonger le temps que prend la fonction pour créer le html vu qu'elle est super rapide je voudrais la garder comme tel (instantané chez moi sur petit pc portable )

alors toi tu en es ou de l'adaptationde mon code dans ton interface de struture machin chose

 

[patricktoulon]

bon ben comme c'est quelque chose qui m'a titillé 2 seconde (1 de trop)
j'ai trouvé ma logique simple
tu a maintenant le displayGridline true ou false
V4.9 finale
je vais l'adapter pour la V5 finaly sur le menu cells

i'me the first , the better and the only

voila
😉🤣

 

[Dudu2]

En VBA you are the very first, the best and the only one ! En anglais, faudra encore travailler un peu 😛 😉

Je n'ai pas encore essayé ta 4.9 car occupé à coder quelque chose que tu devrais regarder.

Dans ton code ce qui prends beaucoup de temps c'est la création des fichiers Image.
Alors je me suis penché sur la question et j'ai utilisé Publish (et oui, tu l'aimes pas je sais) uniquement pour créer les fichiers Image 1 à 1 pour être sûr (ou presque) de prendre le bon.

Dans ce fichier j'ai mesuré ton code et le mien pour la création des fichiers Image, et y a pas photo.
Sur mon PC: 4 secondes contre 0.5 seconde.

If [L7].Value = "patricktoulon" Then
    'Patrick's function to create the image files from the Range Shapes
    Call DrawingObjects_To_Png_File(Rng, ImagesDirectory)
Else
    'Dudu2's function to create the image files from the Range Shapes
    Call ShapesInRangeToImageFiles(Rng, ImagesDirectory)
End If

 

[patricktoulon]

re
a ben oui c'est rapide
c'est possible d'avoir les images avec ???🤣
résultat

 

[Dudu2]

Ah oui, c'est possible.

 

[Dudu2]

En tous cas avec FireFox, IE, Edge, Chrome. 😛
Après les trucs exotiques qui prennent pas le Base64 ...

 

[patricktoulon]

a ben moi je suis désolé je n'ai pas les images j'ai testé ton fichier comme tel que tu me l'a donné

veux tu que je te dise pourquoi il est impossible que ca aille plus vite ,

ta méthode(tout du moins si j'ai bien compris

tu ouvre un new classeur
tu boucle sur toute les shapes
tu copy
et tu colle la shape du tour de boucle interne à rng
tu publie le classeur temp
tu va chercher l'image et tu la met je ne sais ou et tu delete l'image dans le classeur temp
et ainsi de suite jusqu’à plus shape

ma méthode
add new workbook
boucle sur toutes les shapes
copy + pastepictures
a la fin je sauve le classeur en ".zip"
je recupere toutes les images dans le dossier"xl\media" de l'archive dans un dossier
et c'est tout

toujour est t il que je viens de changer l'environ (temp) pour thsiworkbook.path et je ne vois rien de plus arriver sur mon bureau
????????????????????????????

 

[Dudu2]

@patricktoulon, je ne t'ai pas envoyé ce truc sans l'avoir vérifié et testé évidemment.
Ce n'est pas une compétition de méthodes entre le tienne et la mienne.
C'est juste utiliser la méthode la plus rapide. Et les résultats que je t'ai annoncés, je les ai sur mont PC.

Après tu fais comme tu veux de ton coté. Pour Outlook j'utiliserai ton code qui est remarquable, sauf pour la création des fichiers Image qui n'est qu'une petite partie et qui va bien plus vite (8x) avec la méthode que j'ai proposée.

 

[Dudu2]

V4.9 -> Super l'option sur le DisplayGridlines. Ça marche nickel.

 

[patricktoulon]

re
bon allez je te l'accorde
je réécrit ma fonction avec ton principe
et là ça marche et effectivement c'est un poil plus rapide

ça veut dire que ta façon de coder n'est pas universelle puisque chez moi comme tel elle n'a pas fonctionné

pour une ressource c'est ennuyant si on doit se retaper tout le code avant d'y arriver
c'est juste un conseil
ca doit marcher chez toi comme chez moi sans que l'on doit intervenir dans le code

donc ta methode , mon ecriture
au plus simple
et elle est même un poile C.. mais alors presque rien plus rapide

ET EN PLUS !! on peut même se permettre de renommer l'image puisque ça se fait dans la même boucle

Option Explicit
Sub testnew()
    Dim Rng As Range, cheminfinal$
    Set Rng = Feuil1.[C4:I13]
    cheminfinal = ThisWorkbook.Path & "\imagescapturée"
    DrawingObjects_To_Png_File3 Rng, cheminfinal
End Sub
Function DrawingObjects_To_Png_File3(Rng As Range, dossier$)
   Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Dim WbK As Workbook, calque As Worksheet, nomHtml, tim, chemin$, ShP As Object
    tim = Timer
    nomHtml = "tempo"

    chemin = ThisWorkbook.Path & "\" & nomHtml
    If Dir(dossier, vbDirectory) <> "" Then Kill dossier & "\*": RmDir dossier
    MkDir dossier

     Set WbK = Workbooks.Add
    Set calque = WbK.Sheets(1)

    For Each ShP In Rng.Parent.DrawingObjects
        If Not Intersect(ShP.TopLeftCell, Rng) Is Nothing Then
            ShP.Copy: calque.Pictures.Paste
            WbK.SaveAs Filename:=chemin & ".htm", FileFormat:=xlHtml, ReadOnlyRecommended:=False, CreateBackup:=False
            Name chemin & "_fichiers\image001.png" As dossier & "\" & Replace(ShP.Name, " ", "_") & ".png"
            calque.DrawingObjects.Delete
        End If
    Next
    WbK.Close
    Kill chemin & ".htm"
    Kill chemin & "_fichiers\*": RmDir chemin & "_fichiers"
    MsgBox Format(Timer - tim, "#0.000 Sec")
End Function

Donc autant pour moi tu avais raison
cette methode est plus rapide

 

[patricktoulon]

V4.9 -> Super l'option sur le DisplayGridlines. Ça marche nickel.

oui ben je l'ai cherché cette logique
pourtant c'est 3 lignes de code 🤣🤣🤣

 

[Dudu2]

puisque chez moi comme tel elle n'a pas fonctionné

Ben ça, ça me dépasse car il n'y a rien de spécifique dans ce code.
Enfin si tu le dis...
Faudrait que si @Usine à gaz passe par là, qu'il essaie le fichier du Post #321.

bon allez je te l'accorde

Monseigneur est trop bon 😂

effectivement c'est un poil plus rapide

Oui, juste un poil, entre 6 et 8 fois 🙃 C'est un gros poil alors 😂

 

[patricktoulon]

re
ben en fait c'est juste un paramétrage d'aces au disk dans windows
chez moi ta méthode avec mon écriture 1.300 et ma méthode 1.500
c'est aussi du a ton antivirus aussi les dossiers windows et users sont très surveillé ce qui rend leur acces plus ou moins long par vba ou autre

ce qui fait que parfois ce qui est long chez moi va être rapide chez toi et vice et versa