XL 2019 Coller une image dans une UserForm

Marc Vanlindt

XLDnaute Nouveau
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
 

Pièces jointes

  • CollerImageUSF.xlsm
    47.4 KB · Affichages: 10
Solution
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

XLDnaute Barbatruc
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

XLDnaute Nouveau
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...
 

Pièces jointes

  • jpgmp3.png
    jpgmp3.png
    12 KB · Affichages: 7

Marc Vanlindt

XLDnaute Nouveau
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

XLDnaute Barbatruc
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

XLDnaute Nouveau
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é.
 

Pièces jointes

  • L'optimisme 02.zip
    745.4 KB · Affichages: 4
  • folder.jpg
    folder.jpg
    90.9 KB · Affichages: 6

patricktoulon

XLDnaute Barbatruc
re
d'abords bonjour
et ensuite
1712046658454.png
 

patricktoulon

XLDnaute Barbatruc
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
 

Marc Vanlindt

XLDnaute Nouveau
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
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.
 

Pièces jointes

  • jpeg_bin.png
    jpeg_bin.png
    157.3 KB · Affichages: 8

Marc Vanlindt

XLDnaute Nouveau
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
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

XLDnaute Barbatruc
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
demo.gif

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

XLDnaute Nouveau
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
 

Pièces jointes

  • MP3JPG.xlsm
    17.9 KB · Affichages: 2

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Marc, Patrick,
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 ...
 

Discussions similaires

Statistiques des forums

Discussions
313 309
Messages
2 097 033
Membres
106 812
dernier inscrit
Excellou74