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]

Maintenant si c'est juste pour convertir du Base64 en image ça peut se faire directement.

 

[patricktoulon]

Maintenant si c'est juste pour convertir du Base64 en image ça peut se faire directement.

???????????????

 

[patricktoulon]

re
chez moi

 

[Dudu2]

Ok, et si tu places ton IEFRAME.DLL sur cjoint.com pour que je teste ?

 

[Dudu2]

???????????????

Si Base64 est une représentation texte du binaire, y a forcément un décodage inverse.
J'essaie ces fonctions https://www.source-code.biz/snippets/vbasic/12.htm
Après, il faut sans doute tagger le format PNG quelque part, faut voir avec Notepad++ la tête d'une PNG.
Edit: enfin je regarderai plus tard parce que j'ai de la peinture à faire.

 

[Dudu2]

Voilà, les images fonctionnent, sans même gérer les Tags PNG. L'extension doit lui suffire (?).
Et pas besoin de bibliothèque WebBrowser.

Function Base64tofichier(ByVal strData As String, ByVal chemin As String)    ' As Object
    Dim i As Long
    Dim a() As Byte

    strData = Left(strData, Len(strData) - Len(strData) Mod 4)
    a = Base64Decode(strData)
    '///////////////////////////////////
    i = FreeFile: Open chemin For Binary As #i: Put #i, , a: Close #i
MsgBox chemin
End Function

Il faut bien sûr intégrer le module Base64Coder qu'on trouve sur ce site https://www.source-code.biz/snippets/vbasic/12.htm
Merci à notre ami suisse Christian d'Heureuse.

 

[patricktoulon]

Bonjour @Dudu2
heu... le strdata tu le prends bien quelque part non ?

 

[Dudu2]

heu... le strdata tu le prends bien quelque part non ?

Ben oui, c'est ton code qui la fournit (D).
Tout ça c'est ton code adapté. Voir fichier joint.
Après je te laisse terminer le boulot

 

[Dudu2]

Tu sais moi je fais rien. Je prends le code des autres, je bidouille un peu et je rentre à la maison

 

[patricktoulon]

j'ai peut etre trouver une autre solution pour récupérer les shape en png
et oui je ne m'arrete jamais de tourner virer

en fouillant dans le zip du classeur j'y ai decouvert un dossier"Media"
dans le quel il y a toutes les <<PICTURE>>
a ben je me suis dis a mince comment faire pour aller chercher dans l'archive d'un classeur ouvert
ben que cela te tienne savecopyAs/convertarchive/recup dans le dossier media de l'archive

bon ca reste encore a pofiner et transformer ça en fonction et qui puis est recursive pour X images mais ca reste une option valable surtout que c'est rapide

prends un fichier vierge
met lui une shape un peu translucide pour le test
cette shap appelle la "rond1" ou change le nom dans le code qui suit
maintenant colle ca dans un module

Sub test()
'on copy la shape en image

    Set shap = ActiveSheet.Shapes("rond1")

    shap.Copy    'on copie la shape
    ActiveSheet.Pictures.Paste.Select    'on la colle entant qu'image

    Set image = Selection
    Selection.ShapeRange.Name = "monimage"

    'on determine un repertoire de destination
    dossier = Environ("userprofile") & "\Desktop\recup"

    ' on le crée si il n'existe pas
    If Dir(dossier, vbDirectory) = "" Then MkDir dossier

    'determine le nom de l'archive
    n1 = Environ("userprofile") & "\DeskTop\archive.xlsm"
    n2 = Environ("userprofile") & "\DeskTop\archive.zip"


    img = "xl\media\Image1.png"     'Url de l'image dans l'archive

    ThisWorkbook.SaveCopyAs n1      'on fait une copie du classeur


    Name n1 As n2                   'on le transforme la copie du classeur  en archive


    ' on va chercher l'image dans l'archive
    ' en early binding                     reference "microsoft shell control and automation" requise
    'Dim Archive As Shell
    'Set Archive = New Shell

    'late binding dans reference à activer
    Dim Archive As Object
    Set Archive = CreateObject("Shell.Application")

    Archive.Namespace(dossier).CopyHere Archive.Namespace(n2).Items.Item(img)
    Set Archive = Nothing
    Kill n2'on kill l'archive on en a plus besoins
    Name dossier & "\Image1.png" As dossier & "\" & image.Name & ".png"'on renomme l'image (fichier) avec le nom qu'on lui a donné dans la feuille
    image.Delete'on delete l'image dans la feuille on en a plus besoins non plus
End Sub

a ben j'ai des idées moi hein

 

[patricktoulon]

au fait
avec 'Left(strData, Len(strData) - Len(strData) Mod 4)
c'est moi maintenant qui est le message

chez moi strData tout court fonctionne tres bien

le base64 n'est donc pas un chemin a prendre

 

[Dudu2]

avec 'Left(strData, Len(strData) - Len(strData) Mod 4)
c'est moi maintenant qui est le message

Je sais pas comment tu t'y prends parce que ce message est issu de l'Element créé du XMLDocument.
La conversion que je t'ai indiquée n'a PLUS RIEN A VOIR avec ça. C'est une simple conversion d'une chaine vers une autre (ou plutôt vers un tableau de Byte) qui n'utilise aucune bibliothèque et seulement du code standard.

 

[Dudu2]

Utilise le fichier que j'ai posté en #172. S'il fonctionnne pour moi pour la création des images, il fonctionne nécessairement pour toi. Exit les XML Documents.
De toutes façons si tu ne l'utilises pas, ton code est voué à une utilisation très limitée pour les raisons déjà indiquées que personne ne prendra la peine de revenir sur IE10 juste pour faire du HTML. A supposer que les nouveaux utilisateur sous Edge aient seulement connaissance d'IE.

Après, of course, tu fais comme tu veux

 

[patricktoulon]

re
au fait avec mon voisin on a essayé sur son Windows 10 avec IE 11 qui n'est plus actif (on a fait la mise a jour update pour ca) de toute facon il ne s'en sert pas
et on a eteind et redemarrer le pc
resultat apres redemarrage :ces librairies en late binding fonctionnent toujours (createobject("htmlfile") et createobject("microsoft.xmlxml2")
par contre IE bye !! bye

 

[patricktoulon]

Bonjour @Dudu2
j'ai enfin mis au point une fonction pour récupérer les shapes et images sans webbrowser
je n'utilise que la shell Automation comme librairie

je vais la mettre dans les ressource dans la journée

petite question :
tu m'a dis qu'en earlybinding le htmldocument fonctionnait pour créé simplement la table
me confirme tu toujours ce point aujourd'hui ??