XL 2019 Coller une image dans une UserForm

Marc Vanlindt · 31 Mars 2024

Bonjour à tous.
Dans ma feuille excel, j'ai une image que je voudrais copier dans ma Userform1.Image1.
Comment puis-je réaliser cela en VBA ?
Merci d'avance pour vos réponses.
Marc

patricktoulon · 2 Avril 2024

Marc Vanlindt à dit:
Désolé. J'ai sans doute mal utilisé cjoint... Mais sur tu fais un click droit sur le le nom du ficher (juste après "Document joint :", tu choisis l'option "Enregistrer la cible du lien" et il sera télécharger.

oui j'ai vu après
mais comme j'ai bloqué certaines partie de ce menu j'ai du le remettre pour le faire
et après test ce fichier comme je te l'ai dis l'image a bien été extraite
avec mon code de base et tout mes autres méthodes fonctionnent aussi
ce code date d'il y a 7 ans il ne m'a jamais fait défaut

VB:

Sub extract_image_In_File()
    Dim OBJstream, BB() As Byte, b As Long, bytTemp(0 To 1) As Byte, tablo, by As Byte
    Dim filetoopen As Variant
     filetoopen = Application.GetOpenFilename("jpeg Files...

Dranreb · 1 Avril 2024

Bonsoir.
Ceci fonctionne chez moi, dans l'UserForm1 :

VB:

Option Explicit
Private Sub UserForm_Click()
   ShapeImg(Me.Image1) = Feuil1.Shapes(1)
   End Sub
Private Property Let ShapeImg(ByVal Img As MSForms.Image, ByVal RHS As Excel.Shape)
Rem. Inspiré d'un code de patricktoulon
   Dim FicTemp As String, HImg As LongPtr, HEMF As LongPtr
   ExecuteExcel4Macro "CALL(""user32"",""OpenClipboard"",""JJ"",0)"
   ExecuteExcel4Macro "CALL(""user32"",""EmptyClipboard"",""J"")"
   ExecuteExcel4Macro "CALL(""user32"",""CloseClipboard"",""J"")"
   RHS.CopyPicture
   DoEvents
   Do While ExecuteExcel4Macro("CALL(""user32"",""IsClipboardFormatAvailable"",""JJC"",14)") = 0
      If MsgBox("Instruction: Shapes(""" & RHS.Name & """).CopyPicture" & vbLf & _
         "Le presse papier ne semble pas recevoir l'image.", _
         vbRetryCancel, "Property Set ShapeImg") = vbCancel Then Exit Property
      Loop
   ExecuteExcel4Macro "CALL(""user32"",""OpenClipboard"",""JJ"",0)"
   HImg = ExecuteExcel4Macro("CALL(""user32"",""GetClipboardData"",""JJ"",14)")
   FicTemp = Environ$("UserProfile") & "\DeskTop\Temp.wmf"
   HEMF = ExecuteExcel4Macro("CALL(""gdi32"",""CopyEnhMetaFileA"",""JJC""," & HImg & ",""" & FicTemp & """)")
   ExecuteExcel4Macro "CALL(""gdi32"",""DeleteEnhMetaFile"",""JJ""," & HEMF & ")"
   ExecuteExcel4Macro "CALL(""user32"",""CloseClipboard"",""J"")"
   Img.Picture = LoadPicture(FicTemp): Kill FicTemp
   End Property

Marc Vanlindt · 1 Avril 2024

patricktoulon à dit:
re
normalement si je me souvient bien (je sais plus ) en lecture en binaire (bits par bits)
un jpg commence par 255 et 224 et 0 et termine par 217 et 255

J'ai vérifié les fichiers jpg générés par Excel comparativement à une photo normale. Voir le résultat en annexe.
Toutes commencent et terminent bien par 255. Le reste semble plutôt aléatoire...

Marc Vanlindt · 1 Avril 2024

Dranreb à dit:

Bonsoir.
Ceci fonctionne chez moi, dans l'UserForm1 :

VB:

Option Explicit
Private Sub UserForm_Click()
   ShapeImg(Me.Image1) = Feuil1.Shapes(1)
   End Sub
Private Property Let ShapeImg(ByVal Img As MSForms.Image, ByVal RHS As Excel.Shape)
Rem. Inspiré d'un code de patricktoulon
   Dim FicTemp As String, HImg As LongPtr, HEMF As LongPtr
   ExecuteExcel4Macro "CALL(""user32"",""OpenClipboard"",""JJ"",0)"
   ExecuteExcel4Macro "CALL(""user32"",""EmptyClipboard"",""J"")"
   ExecuteExcel4Macro "CALL(""user32"",""CloseClipboard"",""J"")"
   RHS.CopyPicture
   DoEvents
   Do While ExecuteExcel4Macro("CALL(""user32"",""IsClipboardFormatAvailable"",""JJC"",14)") = 0
      If MsgBox("Instruction: Shapes(""" & RHS.Name & """).CopyPicture" & vbLf & _
         "Le presse papier ne semble pas recevoir l'image.", _
         vbRetryCancel, "Property Set ShapeImg") = vbCancel Then Exit Property
      Loop
   ExecuteExcel4Macro "CALL(""user32"",""OpenClipboard"",""JJ"",0)"
   HImg = ExecuteExcel4Macro("CALL(""user32"",""GetClipboardData"",""JJ"",14)")
   FicTemp = Environ$("UserProfile") & "\DeskTop\Temp.wmf"
   HEMF = ExecuteExcel4Macro("CALL(""gdi32"",""CopyEnhMetaFileA"",""JJC""," & HImg & ",""" & FicTemp & """)")
   ExecuteExcel4Macro "CALL(""gdi32"",""DeleteEnhMetaFile"",""JJ""," & HEMF & ")"
   ExecuteExcel4Macro "CALL(""user32"",""CloseClipboard"",""J"")"
   Img.Picture = LoadPicture(FicTemp): Kill FicTemp
   End Property

Merci beaucoup.
Patrick Toulon m'a déjà fait parvenir une solution qui fonctionne parfaitement.
Je suppose que la source est similaire. En tous cas, sa solution est parfaite.
Merci encore et bonne soirée.
Marc

patricktoulon · 1 Avril 2024

re
ben en fait @Dranreb a arrangé ma solution en macro4 dans un let bien pensé je doit dire ,je suis séduis

sauf qu'en macro4(donc api non déclarées on peut difficilement mettre des type structure dans les arguments des apis
donc celle que je t'ai donné utilise les même api mais déclarées en bon et due forme mais je ne passe pas par un fichier temporaire j'utilise l'object ipictureDisp qui contient les datas de l'image

en gros
userform. image1.picture=mon ipicturedisp dynamique que j'ai créé dynamico avec la fonction
c'est dommage que je n'ai pas d'exemple mp3 avec image
je pourrais travailler en binaire simplement sans passer par la copie d'image sur feuille

Marc Vanlindt · 2 Avril 2024

patricktoulon à dit:
re
ben en fait @Dranreb a arrangé ma solution en macro4 dans un let bien pensé je doit dire ,je suis séduis

sauf qu'en macro4(donc api non déclarées on peut difficilement mettre des type structure dans les arguments des apis
donc celle que je t'ai donné utilise les même api mais déclarées en bon et due forme mais je ne passe pas par un fichier temporaire j'utilise l'object ipictureDisp qui contient les datas de l'image

en gros
userform. image1.picture=mon ipicturedisp dynamique que j'ai créé dynamico avec la fonction
c'est dommage que je n'ai pas d'exemple mp3 avec image
je pourrais travailler en binaire simplement sans passer par la copie d'image sur feuille

Qu'à cela ne tienne. Voici en annexe un mp3 contenant une image ainsi que l'image jpg qui s'y trouve.
Pour info, le mp3 est de basse qualité sinon il était trop volumineux. Il est libre de droit (c'est moi qui ai composé la musique...). Il est dans le fichier ZIP parce qu'un fichier mp3 ne peut pas être envoyé.

patricktoulon · 2 Avril 2024

re
d'abords bonjour
et ensuite

Marc Vanlindt · 2 Avril 2024

patricktoulon à dit:
re
d'abords bonjour
et ensuite
Regarde la pièce jointe 1194080

Sans doute parce qu'il a été généré avec 7zip. Voidi un lien sur lequel on peut le télécharger : http://www.boudu.be/mp3/ (C'est mon site personnel - pas de virus)

patricktoulon · 2 Avril 2024

re
sur ton nouveau lien on peut écouter mais pas télécharger
met le sur cjoint ton mp3

Marc Vanlindt · 2 Avril 2024

patricktoulon à dit:
re
sur ton nouveau lien on peut écouter mais pas télécharger
met le sur cjoint ton mp3

re
Pour le télécharger, click droit -> enregistrer le cible du lien sous...
Je ne peux pas joindre un fichier mp3 (message : Le fichier téléchargé n'a pas d'extension autorisée...)

patricktoulon · 2 Avril 2024

re
ok a première vue dans l'analyse visuelle du tableau de bits
j'ai bien un départ (du moins presque )de l'image mais je n'ai pas de fin
donc certainement l'image que tu crée a des donnée supplémentaire
qui fait que l'image parfois est valide et des fois non
je dis ça j'ai cherché les index mano mano
je vais le faire en automatique pour voir

je n'arrive pas a me rappeler pour le jpeg si c'est 255 234 0 le départ et fin
je les avais ces trucs mais je ne les ai plus

ton mp3 en tableau de bits joint

mp3-en-tableau-bits.xlsx

Le service des pièces jointes, CJoint.com est un service de partage de fichier gratuit pour partager vos documents dans vos courriels, sur les forums ou dans vos petites annonces.

www.cjoint.com

Marc Vanlindt · 2 Avril 2024

patricktoulon à dit:
re
ok a première vue dans l'analyse visuelle du tableau de bits
j'ai bien un départ (du moins presque )de l'image mais je n'ai pas de fin
donc certainement l'image que tu crée a des donnée supplémentaire
qui fait que l'image parfois est valide et des fois non
je dis ça j'ai cherché les index mano mano
je vais le faire en automatique pour voir

je n'arrive pas a me rappeler pour le jpeg si c'est 255 234 0 le départ et fin
je les avais ces trucs mais je ne les ai plus

ton mp3 en tableau de bits joint

mp3-en-tableau-bits.xlsx

Le service des pièces jointes, CJoint.com est un service de partage de fichier gratuit pour partager vos documents dans vos courriels, sur les forums ou dans vos petites annonces.

www.cjoint.com

re
Merci Patrick. Je ne connaissais le service cjoint. Une bonne chose !
Pour la structure JPG, j'ai trouvé un tableau sur internet. Il est en annexe.
Je constate que la longueur est définie par 16 octets mais je ne sais pas comment définir cette valeur en un nombre décimal.

Marc Vanlindt · 2 Avril 2024

patricktoulon à dit:
re
ok a première vue dans l'analyse visuelle du tableau de bits
j'ai bien un départ (du moins presque )de l'image mais je n'ai pas de fin
donc certainement l'image que tu crée a des donnée supplémentaire
qui fait que l'image parfois est valide et des fois non
je dis ça j'ai cherché les index mano mano
je vais le faire en automatique pour voir

je n'arrive pas a me rappeler pour le jpeg si c'est 255 234 0 le départ et fin
je les avais ces trucs mais je ne les ai plus

ton mp3 en tableau de bits joint

mp3-en-tableau-bits.xlsx

Le service des pièces jointes, CJoint.com est un service de partage de fichier gratuit pour partager vos documents dans vos courriels, sur les forums ou dans vos petites annonces.

www.cjoint.com

re
Je crois que mon message précédent est incomplet. Pour info, voici la page que j'ai trouvée décrivant la structure d'une image jpg. (http://sylvain.fish.free.fr/JPEG_SIZE/Read_jpeg_size.htm)
Structure JPG

patricktoulon · 2 Avril 2024

en fait j'ai ressorti mes archives
et j'ai retrouvé cette discussion d'il y a 7 ans sur DVP
avec des fichiers catiapart

du coup j'ai fait le test
et dans ton mp3 je trouve
37 débuts(255,216)
et
48 fins (255,217)

somme toute c'est pas une erreur un bit c'est un bit c'est tout
sauf que pour aller chercher la bonne séquence ben ça va être coton

VB:

Sub control_index_Jpg()
    Dim OBJstream, BB() As Byte, ok As Boolean, i As Long, f As Long, fini As Long
    Dim filetoopen As Variant
     filetoopen = Application.GetOpenFilename("jpeg Files (*.jpg;*.mp3), *.jpg;*.mp3", 1, "ouvrir une image")
    If filetoopen = False Then Exit Sub
   Set OBJstream = CreateObject("ADODB.Stream")    'object utilisé ADODB stream
    OBJstream.Open: OBJstream.Type = 1    ' open with no arguments makes the stream an empty container
    OBJstream.LoadFromFile (filetoopen)    'on load le fichier dans l'object
    BB = OBJstream.Read()    ' on prend directement tout le paquet
    fin = UBound(BB) - 1
 
    '**************************************
    For i = 0 To fin
             If BB(i) = 255 And BB(i + 1) = 217 Then fini = fini + 1
        If BB(i) = 255 And BB(i + 1) = 216 Then deb = deb + 1
 
    Next
 
  Debug.Print "nombre de debut : " & deb
  Debug.Print "nombre de fin  : " & fini
 
End Sub

Marc Vanlindt · 2 Avril 2024

patricktoulon à dit:
en fait j'ai ressorti mes archives
et j'ai retrouvé cette discussion d'il y a 7 ans sur DVP
avec des fichiers catiapart

du coup j'ai fait le test
et dans ton mp3 je trouve
37 débuts(255,216)
et
48 fins (255,217)

somme toute c'est pas une erreur un bit c'est un bit c'est tout
sauf que pour aller chercher la bonne séquence ben ça va être coton
Regarde la pièce jointe 1194088

VB:

Sub control_index_Jpg() Dim OBJstream, BB() As Byte, ok As Boolean, i As Long, f As Long, fini As Long Dim filetoopen As Variant filetoopen = Application.GetOpenFilename("jpeg Files (*.jpg;*.mp3), *.jpg;*.mp3", 1, "ouvrir une image") If filetoopen = False Then Exit Sub Set OBJstream = CreateObject("ADODB.Stream") 'object utilisé ADODB stream OBJstream.Open: OBJstream.Type = 1 ' open with no arguments makes the stream an empty container OBJstream.LoadFromFile (filetoopen) 'on load le fichier dans l'object BB = OBJstream.Read() ' on prend directement tout le paquet fin = UBound(BB) - 1 '************************************** For i = 0 To fin If BB(i) = 255 And BB(i + 1) = 217 Then fini = fini + 1 If BB(i) = 255 And BB(i + 1) = 216 Then deb = deb + 1 Next Debug.Print "nombre de debut : " & deb Debug.Print "nombre de fin : " & fini End Sub

Merci Patrick.
J'ai essayé chez moi et j'ai exactement le même résultat (ce qui est logique...)
Je crois que ça devient beaucoup trop compliqué pour ma petite tête qui n'est plus toute jeune (bientôt 69 ans).
Tu as des connaissances qui me dépassent largement. J'ai fait quelques programme (en Access) il y a 25 ans et je viens seulement de m'y remettre (en Excel cette fois) il y a un mois.
Sur la page web que je t'ai envoyée (http://sylvain.fish.free.fr/JPEG_SIZE/Read_jpeg_size.htm), il y a du code que j'ai fait "traduire" par ChatGpt en VBA mais je n'y comprends pas grand-chose.
Je te l'annexe.
Quoi qu'il en soit, on n'est plus vraiment en Excel là... et ce forum y étant consacré, j'aurais mauvaise grâce à trouver ici une solution pour un problème ne relevant pas d'Excel.
Encore une fois (je suisbelge, hein !) merci.
Bien à toi,
Marc

sylvanu · 2 Avril 2024

Bonjour Marc, Patrick,

Marc Vanlindt à dit:
il y a du code que j'ai fait "traduire" par ChatGpt

J'ai eu la même approche avec ChatGPT, Bard et Aria. Les trois donnent du code ... que je ne suis pas arrivé à faire marcher.
Par contre j'ai trouvé MP3Tag ( Lien ) . Petit utilitaire qui donne les tags et la pochette des MP3, et on peut charger la pochette.
... avec deux bémols bien sur :
1- Je ne suis pas arrivé à automatiser le chargement des pochettes, seulement une par une.
2- Les fichiers générés sont en png.
Mais on peut facilement les convertir en jpg.
Au cas où ça vous intéresse ...

XL 2019 Coller une image dans une UserForm

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Discussions similaires