Microsoft 365 Insérer une image dans un usf ?

[BenHarber]

Bonjour et bonne année Le Forum !
Pour l'instant, je n'ai pas trouvé la réponse à mon pb sur internet, alors je me tourne vers vous.

Je recherche à insérer une image dans le contrôle "image" d'un userform.
La particularité est que l'image est stockée non pas sur un serveur, mais directement dans le fichier Excel où se trouve l'usf : cf. PJ.

Je suppose qu'il faut soit jouer sur la propriété "Picture" du contrôle image, soit écrire un code VBA à l'initialistion de l'usf : mais dans un cas comme dans l'autre, je ne sais pas quoi mettre ! 😭
Quelqu'un aurait-il une idée SVP ?

Merci d'avance pour vos idées et/ou vos suggestions souvent salvatrices ! 💡
BH

 

[fanfan38]

Bonjour
Tu ne peux mettre qu'un fichier
enregistre l'image au même endroit que ton fichier
dans les proprietes picture clic sur les ...
A+ François

 

[BenHarber]

Bonjour Fanfan38,
Merci pour ta réponse.
Effectivement, j'ai lu pas mal de propositions qui vont dans ton sens.
Cependant, je suis certain d'avoir déjà lu sur un site une solution correspondant à ma problématique ! L'ennui, c'est que je n'arrive plus à remettre la main dessus...😣

 

[sylvanu]

Bonjour BenHarber, Fanfan,
Un essai en PJ avec une macro toute faite de Stefen, après il suffit de rajouter :

Sub appelUsf()
    Set Img = ActiveSheet.Shapes("imgCielBleu")
    Img.CopyPicture xlBitmap
    Set UserForm1.Image1.Picture = PastePicture()
    UserForm1.Show
End Sub

 

[Dranreb]

Bonjour.
L'ennui c'est que ça prend l'image affichée par le Shape, ce qui réduit sa définition si sa dimension a été réduite de façon à former une miniature.
C'est pourquoi je n'utilise pratiquement plus les images de formulaire, à part pour des boutons ou des icônes. Les Image ActiveX sont par ailleurs plus simples à manipuler.

 

[BenHarber]

Bonjour BenHarber, Fanfan,
Un essai en PJ avec une macro toute faite de Stefen, après il suffit de rajouter :

Sub appelUsf()
    Set Img = ActiveSheet.Shapes("imgCielBleu")
    Img.CopyPicture xlBitmap
    Set UserForm1.Image1.Picture = PastePicture()
    UserForm1.Show
End Sub

Bonjour Sylvanu,
Merci pour ta réponse. Malheureusement, cela ne fonctionnera pas pour tous les PC qui ouvriront ce fichier (notamment pour les systèmes en 64 bits).
Pas grave, je vais me débrouiller autrement ;-)
Merci quand même !

 

[patricktoulon]

bonjour
bien que je reste admiratif du travail de stephen bullen
je pense que pour la demande on peut faire moins usine à gaz (pardonne moi @sylvanu)

la simple copy en Wmf peut suffire pour l'affichage dans un control image
mon module

'******************************************************************************************************************************************************
'    ___      _     _______  __      _    ____  _   _  _______  ___      _   _    _    ___      _     _.
'   //  \\   /\\      //    // \\   //   //    //  //    //    //  \\   //  //   //   //  \\   //|   //
'  //___//  //__\    //    //__//  //   //    //__||    //    //   //  //  //   //   //   //  // |  //
' //       //   \\  //    //  \\  //   //    //  \\    //    //   //  //  //   //   //   //  //  | //
'//       //    // //    //   // //   //___ //    \\  //     \\__//  //__//   //___ \\__//  //   |//
'******************************************************************************************************************************************************


'capturer une plage ou un object en wmf et créer une image en memoire (Ipicture)pour
's'en servir dans un control image dans un userform
'patricktoulon sur developpez.com
'date/22/03/2010
'remasteurisation du code date: 12/09/2023
' api creation object image
Option Explicit
Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As LongPtr) As LongPtr
Declare PtrSafe Function CopyEnhMetaFileA Lib "gdi32" (ByVal HwndImage As LongPtr, ByVal Direction As String) As LongPtr
Declare PtrSafe Function OleCreatePictureIndirect Lib "OleAut32.dll" (pPictDesc As PICTDESC, ByRef riid As GUID, ByVal fOwn As Long, ByRef ppvObj As IPicture) As Long

Type RECT: Left As Long: top As Long: Right As Long: BOTTOM As Long: End Type
Type GUID: Data1 As Long: Data2 As Integer: Data3 As Integer: Data4(0 To 7) As Byte: End Type
Type PICTDESC: cbSize As Long: picType As Long: himage As LongPtr: hPal As LongPtr: End Type

Function copyxlPicture(obj, Optional Ex_transparency As Boolean = False) As IPicture
    Dim hCopy As LongPtr, PictStructure As PICTDESC, DispatchInfo As GUID, IPic As IPicture, T#, p, Shap
    obj.CopyPicture
    Set p = obj.Parent
    If Ex_transparency = True Then
        p.Paste: Set Shap = p.Shapes(p.Shapes.Count)
        Shap.Fill.Visible = msoTrue: Shap.Fill.ForeColor.RGB = vbWhite: Shap.CopyPicture: Shap.Delete
    End If
    OpenClipboard 0
    T = Timer
    Do While hCopy = 0
        hCopy = CopyEnhMetaFileA(GetClipboardData(14), vbNullString): If Timer - T > 1 Then Exit Do
    Loop
    CloseClipboard
    If hCopy = 0 Then Set copyxlPicture = IPic: Exit Function    ' si pas de handleimage WMF dans clip on arrete tout
    With DispatchInfo
        .Data1 = &H7BF80980: .Data2 = &HBF32: .Data3 = &H101A: .Data4(0) = &H8B: .Data4(1) = &HBB
        .Data4(2) = &H0: .Data4(3) = &HAA: .Data4(4) = &H0: .Data4(5) = &H30: .Data4(6) = &HC: .Data4(7) = &HAB
    End With
    With PictStructure: .cbSize = Len(PictStructure): .picType = 4: .himage = hCopy: .hPal = 0: End With
    OleCreatePictureIndirect PictStructure, DispatchInfo, True, IPic
    Set copyxlPicture = IPic
End Function

un userform montrant des exemple d'utilisation

 

[sylvanu]

Re,
Alors une méthode simple, voir PJ.
On enregistre l'image, on la met dans l'USF et on supprime l'image.
C'est bestial mais ça marche.
( au risque de me faire vilipender par Patrick 😂 )

 

[patricktoulon]

non pas du tout
je vais pas te vilipender
et pour ce qui concerne la methode chart pense à ceux qui sont en 64 bits (la latence de la memoire )
c'est pourtant un phénomène connu avec le past picture sur chart

Sub appelUsf()
    ' Sauvegarde image
    Dim Img As Object
    Set Img = ActiveSheet.Shapes("imgCielBleu")
    Img.Copy
    Set ch = ActiveSheet.ChartObjects.Add(0, 0, Img.Width, Img.Height)
    ch.Border.LineStyle = 0
    Do While ch.Chart.Pictures.Count = 0
        ch.Chart.Paste
    Loop
    ch.Chart.Export ThisWorkbook.Path & "\Image.jpg", FilterName:="JPG"
    ch.Delete
    ' Incruste image
    With UserForm1.Image1
        ' Insérer Image dans le contrôle
        .Picture = LoadPicture(ThisWorkbook.Path & "\Image.jpg")
        'Ajuster la taille
        .PictureSizeMode = fmPictureSizeModeStretch
        'Ajuster Position
        '.Left = 50
        '.Top = 10
    End With
    ' Supprime la sauvegarde de l'image
    Kill ThisWorkbook.Path & "\Image.jpg"
    ' Affiche l'USF
    UserForm1.Show
End Sub

 

[jurassic pork]

Hello,
pour faire ce genre d'opération il y a aussi le module de classe stdClipboard de l'excellente bibliothèque stdVba . Cela ressemble au code de Patricktoulon.
Voici un exemple de code :
1 - Pour copier une forme bitmap dans un Usf
2 - Pour copier une forme vectorielle dans un Usf

Sub AfficheShpImg()
  ActiveSheet.Shapes("imgCielBleu").CopyPicture xlScreen, xlBitmap ' Bitmap
  stdClipboard.Await
  Set UserForm1.Image1.Picture = stdClipboard.Picture
  UserForm1.Image1.PictureSizeMode = fmPictureSizeModeStretch
' Affiche l'USF
  UserForm1.Show
End Sub

Sub AfficheEmfImg()
  ActiveSheet.Shapes("imgArmoirie").CopyPicture xlScreen, XLPicture ' Vecteur
  stdClipboard.Await
  Set UserForm1.Image1.Picture = stdClipboard.Picture
  UserForm1.Image1.PictureSizeMode = fmPictureSizeModeClip
' Affiche l'USF
  UserForm1.Show
End Sub

En pièce jointe un classeur qui contient une forme avec une image Bitmap et une forme vectorielle
Le code + la classe stdClipboard.
Il y a un bug sur l'affichage du format vectorielle, il n' y a qu'un quart de l'image. Si patricktoulon pouvait se
pencher sur le problème et me dire si avec un de ses codes il arrive à afficher correctement l'image vectorielle dans l' USF.
Ami calmant, J.P

 

[patricktoulon]

Bonjour @jurassic pork je vais regarder
aujourd'hui je met le creatorRibbonx v 2025 dans les ressources beaucoup de travail
de présentation et je suis un peu en retard au niveau des videos tutorielles
mais promis je regarde donne moi tout les lien de la librairie si il faut aller les chercher et tout et tout

 

[jurassic pork]

hello patrick,
tu as le le lien du stdvba dans mon message précédent et le module de classe stdclipboard est dans mon classeur de test

 

[patricktoulon]

ok rien avoir avec le stdvba
en fait le wmf(widows Meta File caprture l'image dans une très grande dimension
ça à toujours été comme ça
car la structure du bitmap n'est pas renseignée
en gros les datas du wmf n'ont pas tout les détails du bitmap en terme de structure
du coup le pictureSizeModeClip n'est pas indiqué il faut le zoom

enregistre le ipicture créé dans un fichier en mode jpg et wmf pour la même image et ouvre les avec paint
tu va comprendre tout de suite le wmf ne contient pas la miniature comme le jpeg
c'est pour ça que je préfère de loin le wmf pour le transfert de shapes dans un controls image la qualité n'a pas d'égale, j'en parle un peu dans les ressources que j'avais publié à ce sujet

 

[patricktoulon]

tiens essaie ça et regarde les fenêtres paint

Sub saveimageformat()
    ActiveSheet.Shapes("imgArmoirie").CopyPicture xlScreen, XLPicture ' Vecteur
    stdClipboard.Await
    Set UserForm1.Image1.Picture = stdClipboard.Picture

    ActiveSheet.Shapes("imgArmoirie").CopyPicture xlScreen, xlBitmap ' Bitmap
    stdClipboard.Await
    Set UserForm1.Image2.Picture = stdClipboard.Picture

    SavePicture UserForm1.Image2.Picture, Environ("userprofile") & "\desktop\armoirerie.jpg"
    SavePicture UserForm1.Image1.Picture, Environ("userprofile") & "\desktop\armoirerie.wmf"
    Shell """" & Environ("SystemRoot") & "\system32\mspaint.exe" & """ """ & Environ("userprofile") & "\desktop\armoirerie.jpg" & """", vbNormalFocus
    Shell """" & Environ("SystemRoot") & "\system32\mspaint.exe" & """ """ & Environ("userprofile") & "\desktop\armoirerie.wmf" & """", vbNormalFocus

End Sub

 

[jurassic pork]

merci bien patrick,
mais tu as changé koi pour que cela fonctionne dans mon classeur ? moi j'ai toujours qu'un quart de l'image dans l'usf quelque soit le mode d'image.