XL 2019 Image dans UserForm

JLR67

XLDnaute Nouveau
Bonjour le Forum,

Je souhaiterais savoir s'il est possible d'incérer une image dans un UserForm, en sachant que cette image peut être modifiée sur le fichier (en fait, c'est une copie d'un TCD, avec lien)
Et si oui avez vous une solution pour moi.
Ci joint petit fichier en exemple sur lequel la copie de l'image se par par la propriété Picture (mais malheureusement la mise à jour n'est pas possible).
Merci à ceux qui voudront bien me venir en aide
 

Pièces jointes

  • Feuil1.xlsm
    56 KB · Affichages: 9

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour JLR,
Comme je ne sais pas intégrer l'image présent dans le classeur dans un userform, je triche.
Je rafraichit le TCD
J'exporte le TCD sous forme d'image et l'enregistre.
Je met ce fichier comme image dans l'userform.
Je supprime ce fichier image.
NB: La feuille Image devient donc inutile.
 

Pièces jointes

  • Feuil1 (2).xlsm
    42.4 KB · Affichages: 6

patricktoulon

XLDnaute Barbatruc
re
Bonsoir tout les deux
Comme je ne sais pas intégrer l'image présent dans le classeur dans un userform, je triche.
sinon on crée un pictureDISP en memoire
sans passer par un export fichier externe
a peine un peu de recherche vous auriez trouvé je l'ai donné plusieurs fois

donc dans cet exemple mon module WMF3 qui fait exactement ça
pour le coup bien évidemment je supprime la feuille image qui n'est plus nécessaire
le Ipicture contenant les data de la capture du pivotTable(1) de la feuille base va directement dans le controls Image1 de l'userform
demo.gif

maintenant vous savez comment on fait ;)
 

Pièces jointes

  • version patosh.xlsm
    28.5 KB · Affichages: 11

patricktoulon

XLDnaute Barbatruc
re
voila
j'ai un doute sur la Olecreatepictureindirecte essaie l'autre si ça ne fonctionne pas en bloquant la première
code complet du module
VB:
'******************************************************************************************************************************************************
'    ___      _     _______  __      _    ____  _   _  _______  ___      _   _    _    ___      _     _.
'   //  \\   /\\      //    // \\   //   //    //  //    //    //  \\   //  //   //   //  \\   //|   //
'  //___//  //__\    //    //__//  //   //    //__||    //    //   //  //  //   //   //   //  // |  //
' //       //   \\  //    //  \\  //   //    //  \\    //    //   //  //  //   //   //   //  //  | //
'//       //    // //    //   // //   //___ //    \\  //     \\__//  //__//   //___ \\__//  //   |//
'******************************************************************************************************************************************************


'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
#If VBA7 Then
    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
#Else
    Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function EmptyClipboard Lib "user32" () As Long
    Declare Function CloseClipboard Lib "user32" () As Long
    Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
    Declare Function CopyEnhMetaFileA Lib "gdi32" (ByVal HwndImage As Long, ByVal Direction As String) As Long
    
   ' Declare Function OleCreatePictureIndirect Lib "OleAut32.dll" (pPictDesc As PICTDESC, ByRef riid As GUID, ByVal fOwn As Long, ByRef ppvObj As IPicture) As Long
    Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PICTDESC, riid As GUID, ByVal fOwn As Long, ppvObj As IPicture) As Long


#End If

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 PictStructure As PICTDESC, DispatchInfo As GUID, IPic As IPicture, T#, p, Shap
    #If VBA7 Then
        Dim hCopy As LongPtr
    #Else
        Dim hCopy As Long
    #End If
    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
 

job75

XLDnaute Barbatruc
Bonjour JLR67, sylvanu, Patrick,

L'utilisation d'un graphique auxiliaire est quand même la solution la plus simple :
VB:
Private Sub UserForm_Initialize()
Dim fichier$
fichier = ThisWorkbook.Path & "\MonImage.jpg"
ThisWorkbook.RefreshAll
With ActiveSheet.PivotTables(1).TableRange2
    .CopyPicture xlScreen, xlBitmap 'copie dans le presse-papiets
    With ActiveSheet.ChartObjects.Add(2000, 0, .Width, .Height).Chart
        .Parent.Activate
        Do: .Paste: DoEvents: Loop While .Shapes.Count = 0 'en attente du collage
        .Export fichier
        .Parent.Delete
    End With
End With
Image1.Picture = LoadPicture(fichier)
Kill fichier
End Sub
A+
 

Pièces jointes

  • Feuil1.xlsm
    59.1 KB · Affichages: 6

patricktoulon

XLDnaute Barbatruc
re
@job75
oui mais plus lourd à l’exécution
mes modules sont autonome
c'est des fonctions utilisables comme tel de 2007 à 2021
tu colle dans un module tu utilise

de plus la qualité de la capture avec un graph dépend de la qualité de ta carte graphique à l'inverse le wmf est basé sur les data de la capture
la meilleur qualité d'export avec un graph est le png mais il n'arrive pas à la qualité du wmf
 

patricktoulon

XLDnaute Barbatruc
re
iens pour @job75 voici une capture qui montre deux instances de paint
qui contiennent
l'une la capture JPG (à droite) par graph et l'autre en WMF( à gauche)
j'ai zoomé pour que l'on voit bien la différence
1708949305598.png


dans le zip les deux capture aux deux formats je te laisse juger avec ton application image
 

Pièces jointes

  • capture.zip
    42.5 KB · Affichages: 5

Discussions similaires

Réponses
68
Affichages
3 K

Statistiques des forums

Discussions
313 198
Messages
2 096 142
Membres
106 503
dernier inscrit
ngomez