XL 2019 Coller une image dans une UserForm

sylvanu à dit:

Bonjour Marc, Patrick,

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

Cliquez pour agrandir...

patricktoulon à dit:

re
perso j'ai plusieurs code qui fonctionnent mais sur ce fichier il me sort une jpg inexploitable

Cliquez pour agrandir...

patricktoulon à dit:

encore une fois le lien est jouable mais pas téléchargeable
ok c'est bon avec le menu

Cliquez pour agrandir...

patricktoulon à dit:

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 (*.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
    '**************************************
    ReDim tablo(UBound(BB))
    For i = 0 To UBound(BB): tablo(i) = BB(i): Next
    code = "255,216" & Split(Split(Join(tablo, ","), "255,216")(1), "255,217")(0) & "255,217"
   Debug.Print code
   tablo = Split(code, ",")
    jpegFile = FreeFile
    Open Environ("userprofile") & "\Desktop\imagetemp.jpg" For Binary Access Write Lock Write As jpegFile
    For i = 0 To UBound(tablo)
        If IsNumeric(tablo(i)) Then by = tablo(i): Put jpegFile, , by
    Next i
    Close jpegFile
End Sub

Cliquez pour agrandir...

patricktoulon à dit:

du genre comme ça par exemple

VB:

Sub extractImageTest()
    Dim by As Byte, jpegFile&, TbL
    Dim filetoopen As Variant
    filetoopen = Application.GetOpenFilename("jpeg Files (*.jpg;*.mp3), *.jpg;*.mp3", 1, "ouvrir une image")
    If filetoopen = False Then Exit Sub
    TbL = GetBinaryArrayJpg_OnFile(filetoopen)
    If Not IsArray(TbL) Then MsgBox "Un problème dans l'extraction c'est produit": Exit Sub
    jpegFile = FreeFile
    Open Environ("userprofile") & "\Desktop\imagetemp.jpg" For Binary Access Write Lock Write As jpegFile
    For i = 0 To UBound(TbL)
        If IsNumeric(TbL(i)) Then by = TbL(i): Put jpegFile, , by
    Next i
    Close jpegFile

End Sub

'cette fonction récupère juste l'array de bits concernant le jpg
Function GetBinaryArrayJpg_OnFile(Fichier)
    Dim OBJstream, BB() As Byte, b As Long, tablo
    Set OBJstream = CreateObject("ADODB.Stream")
    OBJstream.Open: OBJstream.Type = 1
    OBJstream.LoadFromFile (Fichier)
    BB = OBJstream.Read()
    ReDim tablo(UBound(BB))
    For i = 0 To UBound(BB): tablo(i) = BB(i): Next
    code = "255,216" & Split(Split(Join(tablo, ","), "255,216")(1), "255,217")(0) & ",255,217"
    GetBinaryArrayJpg_OnFile = Split(code, ",")
End Function

Cliquez pour agrandir...

patricktoulon à dit:

je viens de passer je ne sais combien de temps sur chatgpt
je lui ai demander de faire mieux que moi plus ortodoxe bref
il m'en a sorti des trucs
rien qui fonctionne

ChatGPT - Extraction de données JPEG

Shared via ChatGPT

chat.openai.com

and the winner is patricktoulon!!!

Cliquez pour agrandir...