Microsoft 365 Coller une image dans un champ image d'un UserForm

[Fab117]

Hello,
Avec les valeurs entrées par l'utilisateur dans mon UserForm, le graphique (Chart1) de l'onglet "Chart" est mis à jour.

Ensuite, je copie le graphique sous forme d'image

L'étape suivante consiterait à coller le graphique dans le champ imgGraph de mon UserForm

Quelqu'un saurait-il comment procéder ?

NB: Je joins un fichier démo

Bonne journée.

Fab

 

[Dudu2]

Bonjour,
Je joins un utilitaire qui permet de mettre différents objets (Image, Range, Graphique) en image dans un UserForm. Je te laisse l'exploiter.

 

[patricktoulon]

bonjour
j'ai ajouté un bouton pour envoyer le chart dans l'image du userform

 

[Dudu2]

En 64 bits faut déclarer:

Function copyimagex(obj)
    Dim IPic As IPicture
    Dim hCopy As LongPtr
    Dim tIID As GUID
    Dim PictStructure As PICTDESC
    Dim x As Double
    Dim Ret As LongPtr

 

[Dudu2]

Alors j'ai voulu intégrer ta méthode dans mon code pour avoir plusieurs options.
Mais je n'ai pas réussi à copier un Range et d'autre part je trouve la qualité d'image (surtout en ratio > 1) assez dégradée.
Tu peux le constater dans ce fichier avec les 2 options...

 

[patricktoulon]

re
c'est un bitmap donc ratio 1
et je l'ai toujours dit le wmf(windowmetafile ou plus simplement appelé dans excel XlPicture)aura un meilleurs visuel )
pour la wmf

'capturer une plage 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

toi ce que tu fait avec le module de stephen bullen c'est
copier en wmf
converti en bmp
compiler dans une structure pour gif,jpg,bmp

moi je copy ici en wmf et compile en wmf (les controls (dans un userform) pouvant contenir une image l'acceptent )
pas besoins de convertir si c'est simplement pour faire un object ipictureDisp
exemple
me.image1.picture=copyxlpicture(toutobject)'respecte la transparence ou le fond xlnone pour le range
si on veux pas la transparence
me.image1.picture=copyxlpicture(toutobject,True)'SUPPRIME la transparence

voila voila

 

[patricktoulon]

ps: si tu veux que ca soit plus precis avec le format bitmapdonc la version 1 post #3
obj.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

 

[Dudu2]

Je vais essayer.
J'ai intégré ton dernier code dans mon fichier, la méthode est sélectionnable sur la feuille.

La différence n'est pas détectable visuellement sur une image ou sur une plage.
Elle l'est sur le Graphique ce que je ne comprends pas car il est d'abord copié / collé en image sur la feuille.

 

[patricktoulon]

ce que je ne comprends pas car il est d'abord copié / collé en image sur la feuille.

en fait c'est en fonction de ce que l'on a copier
pourquoi?:
et bien (je le redit) la fonction copypicture de vba copie par defaut en WMF
donc tout ce qui n'a pas de fond ou a un fond transparent(100%) reste transparent

1° une plage de cellules qui n'a pas été colorée ,contrairement à ce que l'on pourrait croire n'a pas de fond blanc donc ma copie aura dans la photo les cellule transparente

2° toute shape occupe un quadrilatère mais par exemple pour une ellipse il y aura des parties transparentes dans ce quadrilatère

comme la copy se fait en wmf il me faut reblanchir le font de la copie d'une plage
pour cela on recolle la plage copiée en wmf sur la feuille
et sur la shap obtenue on lui rend le fond visible et blanc et on recopie cette shape (picture)

pour le graph on s'en fou il est blanc déjà

démonstration avec mon userform tutoriel
on voit bien que la copie de la plage et la shape en haut du userform est transparente
on vois bien aussi dans la copie du haut ,une cellule blanche qui a vraiment été mise en blanc

 

[Dudu2]

Ok tu connais ces truc mieux que moi. Je constate.

Si tu fais ça:

ps: si tu veux que ca soit plus precis avec le format bitmapdonc la version 1 post #3
obj.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

versus ça:

Obj.Copy

Tu ne peux plus copier le Chart directement. Il faut passer aussi par une copie image du Chart.

De toutes façons, j'ai essayé obj.CopyPicture Appearance:=xlScreen, Format:=xlBitmap dans la méthode du Post #3. et le résultat reste le moins bon des 3 solutions. Même au niveau de l'image oiseau, on voit que c'est moins précis.

 

[patricktoulon]

re
a ben de toute façon c'est clair que le wmf reste le plus précis
chez moi c'est un peu moins précis avec le bitmap mais pas autant que tu semble le suggérer
je suppose qu'il y a d'autre paramètres a prendre en compte
dans tout les cas tu a la solution stephen bullen un peu lourde et la mienne

je ne suis pas sur car ca date
stephen bullen n'est pas l'auteur 1er me semble t il
l'auteur (je crois) était un certain michel Pierron forum vb france et repris par stephen bullen ou l'inverse je sais plus c’était entre 2005/2010 dans ces eaux là
en tout cas c'est sur le model de pierron que j'ai appris a le faire dans VBA
il faudrait que le retrouve ce truc les commentaires dans son code était plus précis

 

[Dudu2]

dans tout les cas tu a la solution stephen bullen un peu lourde et la mienne

Oui, c'est sûr y a plus de code.

sais plus c’était entre 2005/2010 dans ces eaux là

Dans ces années-là, je ne savais même pas que VBA existait !

 

[patricktoulon]

re
si tu veux l'inverse un jour
a savoir ;copier l'image d'un control image dans userform sur une feuille
fait moi signe

 

[Fab117]

Un grand merci à vous deux pour avoir pris le temps de regarder et résoudre mon problème.

Excellent week-end

Fab