XL 2013 Insérer dans un USF une image qui est dans une feuille

[erics83]

Bonjour,

Je cherche à insérer dans un userform une image. J'ai vu certains tutos ou exemples, mais impossible de le reproduire....ou alors, j'ai fait une fausse manip que je ne comprends pas...ou j'ai mal "reproduit" un code....et je n'ai pas compris comment JB manipulait les contrôle image dans son fichier "controle image.xls), donc...suis un peu "perdu", car j'ai beaucoup d'exemple avec des images enregistrées dans le disk dur, mais pas d'exemple (ou pas trouvé) sur des images dans le même fichier...
Pour faire simple (=une fois que j'aurais compris le code, je pourrais le reproduire), lorsque l'USF s'ouvre, il doit afficher l'image qui est en Feuil2....

Merci pour votre aide,

 

[Dranreb]

Bonjour.
En transformant le Shape en une Image ActiveX c'est beaucoup plus simple.

 

[erics83]

Bonjour et merci Dranreb,

J'ai enfin compris grâce à vous les tutos de JB...il fallait faire un ActiveX pour que cela fonctionne...Par contre, je bloque toujours (mais en fait, comme je pensais que c'était simple, je n'avais pas donné tous les éléments...).

En fait, l'"image" est une photo de l'"appareil photo" de Excel : en feuil3, j'ai sélectionné A1:A9, et mis en format photo (en fait ce sera une sélection de shapes qui changeront de couleur en fonction de calculs et j'aimerai récupérer la "photo" que cela donne dans mon USF). mais impossible de le récupérer dans l'USF....j'ai essayé

=INCORPORER(Feuil3!$A$1:$A$9;"")

, marche pas,

=INCORPORER(Feuil3!$A$1:$A$9)

idem...

=Feuil3!$A$1:$A$9

re-idem...fonctionne pas...j'ai essayé de mettre l'image de la photo en "premier plan" sur l'ActiveX, marche pas non plus...

Je pense que ça doit être tout simple, mais....je trouve pas....

Merci pour votre aide,

 

[Dranreb]

Bonjour.
Non, il n'y a pas de passerelle simple entre ces vieux objets dessinés d'Excel et MSForms.
Ne pourriez vous afficher les valeurs de votre plage dans une ListBox ?

 

[erics83]

Bonjour et merci Dranreb,

En fait, il ne s'agit pas de données, mais de shapes qui changent de couleurs en fonction d'un choix..donc pas de listbox....admettons

qui pourrait devenir

(là je prends juste un exemple avec un un smartart, pour l'exemple visuel), donc le principe de l'appareil photo me semblait envisageable...car j'ai vu des exemples développé par Patricktoulon (notamment), dans lesquels via VBA il enregistrait l'image, puis la "rappelait" dans son USF...

Merci pour votre aide,
Eric,

 

[Dranreb]

Mais pourquoi ne pouvez vous pas montrer la feuille Excel tout simplement, en masquant temporairement l'UserForm ?

 

[erics83]

Merci Dranreb,

En fait, dans le USF, il y a des choix et sélections, donc en fonction de ces sélections, l'image change, et ainsi on "voit" directement ce que cela peut donner....mais si cela n'est pas possible, je note votre idée : plutôt que de faire un USF, je peux faire mes sélections dans la feuille Excel via des combobox (comme dans mon USF) et afficher directement l'image...Effectivement certainement plus simple...

Merci pour votre aide,

 

[Dranreb]

Moi, si c'est plus simple à piloter avec des ComboBox, je le ferais quand même avec un petit UserForm ayant sa propriété ShowModal à False.

 

[erics83]

Bonjour Dranreb,

Merci pour l'astuce. J'ai finalement suivi vos conseil du précédent post : je mets mes combobox directement sur la feuille et les calculs donnent directement et au fur et à mesure les résultats .

Merci pour votre aide,

 

[patricktoulon]

Bonjour et merci Dranreb,

En fait, il ne s'agit pas de données, mais de shapes qui changent de couleurs en fonction d'un choix..donc pas de listbox....admettons Regarde la pièce jointe 1172630 qui pourrait devenir Regarde la pièce jointe 1172631 (là je prends juste un exemple avec un un smartart, pour l'exemple visuel), donc le principe de l'appareil photo me semblait envisageable...car j'ai vu des exemples développé par Patricktoulon (notamment), dans lesquels via VBA il enregistrait l'image, puis la "rappelait" dans son USF...

Merci pour votre aide,
Eric,

bonsoir
ben en fait ça l'est toujours(possible)
en terme de qualité je préfère le WMF qui en plus me permet de garder la transparence
cette méthode copie tout object sur feuille en tant qu'image Window Meta Fichier qui est bien sur compatible avec les controls msforms.Image dans les userforms
je dis bien tout object (y compris les ranges<<les cellules a fond xlnone seront transparente c'est tout>>)

désolé d'arriver que maintenant

 

[Dudu2]

Bonjour,
Pour répondre à la question de la copie du Range, j'ai retrouvé cette fonction créée il y a longtemps:

'--------------------------------
'Copy a Range to a UserForm Image
'--------------------------------
'
'Arguments:
'---------
'
'- Rng          : a one area Range
'- ControlImage : an Image Control in the UserForm
'- ResizeUserFormOnImage: if True, the UserForm will focus on the image only (ControlImage.Parent is the UserForm)
'- BackGround   : https://docs.microsoft.com/en-us/office/vba/api/Office.MsoThemeColorIndex (blanc par défaut)
'- RatioImage   : if RatioImage <> 1 then TargetWidth and TargetHeight are ignored
'- TargetWidth  : target image width
'- TargetHeight : target image height
'                 If TargetWidth > 0 and TargetHeight > 0 then the smallest dimension applicable to the image
'                 will be selected to keep the image proportions.
'Example:
'-------
'RangeToImageToFileToUserForm(ActiveSheet[C3:E5], UserForm1.Image1, RatioImage:=1.2)
'--------------------------------
Sub RangeToImageToFileToUserForm(Rng As Range, _
                                 ControlImage As Control, _
                                 Optional ResizeUserFormOnImage As Boolean = False, _
                                 Optional BackGround As Integer = msoThemeColorBackground1, _
                                 Optional RatioImage As Single = 1, _
                                 Optional ByVal TargetWidth As Single = 0, _
                                 Optional ByVal TargetHeight As Single = 0)

Mise en oeuvre:

• Copier le Module_RangeToImageToFileToUsf dans le projet VBA
• Appeler la fonction RangeToImageToFileToUserForm() avec les arguments ad hoc
• Voir exemple dans le Module_Test

Edit: pour un code plus évolué, voir Post #42.

 

[patricktoulon]

bonjour @TooFatBoy
j'ai montré plusieurs fois comment gérer l'erreur avec le copypicture et le chart sur 2016
c'est une question de delay
d'autre part je vois que tu paste d'abords sur feuille (c'est inutile et je peux t'expliquer pourquoi)
d'autre part je vois que tu utilise un ersatz de ma formulation ratio
a quoi te sert de calculer le ratio? une capture de plage fait la même dimension que l'original non ?

voilà comment on fait pour capturer un object(shapes,picture,Range, ou tout autre object)avec 2016 et +
sans utiliser les api clipboard pour faire une gestion d'attente

'**********************************************************************************
' __        _____  ___   .  ___         _____  ___             ___
'|__|  /\     |   |   |  | |     | /      |   |   | |   | |   |   | |\  |
'|    /__\    |   |---   | |     |/\      |   |   | |   | |   |   | | \ |
'|   /    \   |   |   \  | |___  |  \     |   |___| |___| |__ |___| |  \|
'
'***********************************************************************************
'                           COLLECTION IMAGE ET SHAPES
'exporter un object en gif(rnange,shapes et tout autre object present sur la feuille)
'version avec graphique 1.1
'date version 03/05/2016
'mise  à jour:15/07/2018
'suppression de la gestion d'attente par l'api IsClipboardFormatAvailable
'remplacer par un multiple paste dans le chart dans que son pictures.count=0(Idée de @Job75)
'**********************************************************************************
Option Explicit

Sub export_Range_To_Image()
    Dim fichier$
    fichier = ThisWorkbook.Path & "\imagetemp.gif"
    ExportOBJECTInImage [Feuil1!A1:F10], fichier
End Sub

Sub export_Object_To_Image()
    Dim fichier$
    fichier = ThisWorkbook.Path & "\ImageObjectTemp.gif"
    ExportOBJECTInImage ActiveSheet.Shapes("Boule"), fichier
End Sub

Function ExportOBJECTInImage(ObjecOrRange, CheminX As String)
    Dim chart1 As Object, hPicAvail As Long
    With CreateObject("htmlfile").parentwindow.clipboardData.clearData("Text"): End With    'on vide le clipboard entre chaque copie pour tester vraiment le available
    ObjecOrRange.CopyPicture
    Set chart1 = ObjecOrRange.Parent.ChartObjects.Add(0, 0, 0, 0).Chart
    With chart1
        With .Parent
            .Width = ObjecOrRange.Width: .Height = ObjecOrRange.Height: .Left = ObjecOrRange.Width + 20:
            '*****************************************************************************
            'suppression de la gestion d'attente avec l'api IsClipboardFormatAvailable
            'Do: DoEvents
            'hPicAvail = ExecuteExcel4Macro("CALL(""user32"",""IsClipboardFormatAvailable"",""JJC""," & 14 & ")")    '2 pour bitmap,14 pour wmf
            ' Loop While hPicAvail = 0
            '*********************************************************************************************
            .Select
            '**************************************************************
            'on va paster directement dans le chart tant que le .pictures.count du chart est égal à zero
             Do: DoEvents
                .Chart.Paste
            Loop While .Chart.Pictures.Count = 0
            '************************************************************
            .Chart.Export CheminX, "jpg"
        End With
    End With
    chart1.Parent.Delete
ExportOBJECTInImage = CheminX
End Function

sauvegarde de l'image garantie
et sans gestion d'erreur

le problème est du au fait que depuis 2013 avec le patch LAA et les versions 2016 et + le clipboard est amputé par l'adresse mémoire allouée a excel qui est de
3.7GIGA pour 2013(avec le patch)
et 4GIGA pour 2016 et +
tandis que pour 2007 on etait à 2 GIGA

 

[TooFatBoy]

bonjour @TooFatBoy

Bonjour à toi...

 

[Dudu2]

@bonjour TooFatBoy,

On ne se parle plus depuis qu'il a qualifié mes posts de "poison" et que la modération est intervenue pour nous séparer dans le pugilat verbal du ruban. Depuis, on utilise ton pseudo pour s'interpeller.

Donc @TooFatBoy,
J'ai essayé ton code et ça plante (Excel 2016):

Sub export_Object_To_Image() et Sub export_Range_To_Image():

C'est cette erreur que j'ai découverte en reprenant l'ancien fichier développé sous 2010 je crois et qui fonctionnait. C'est une erreur étrange qui n'a pas lieu d'être (bug Excel) car si l'instruction part en live, le Chart est quand même créé. C'est pour ça que je suis passé par une gestion d'erreur et je ne vois pas comment faire autrement.

'Create a Chart on the ActiveSheet
    With ActiveSheet
        'Set Ch = .ChartObjects.Add(0, 0, Pic.Width, Pic.Height) <- Erreur en Excel 2016 !
        On Error Resume Next
        .ChartObjects.Add 0, 0, Pic.Width, Pic.Height   'Erreur en Excel 2016 mais le Chart est créé !!:
        On Error GoTo 0
        Set Ch = .ChartObjects(.ChartObjects.Count)
    End With

 

[Dudu2]

d'autre part je vois que tu utilise un ersatz de ma formulation ratio

TargetRatio = Application.Min((TargetWidth / Pic.Width), (TargetHeight / Pic.Height))

Alors ça, sûrement pas, je fais mes calculs tout seul.
D'ailleurs je me souviens de ce calcul de ratio et je dirais que c'est plutôt toi qui me l'as empruntée à l'époque... Puisqu'on en est à discuter des droits d'auteur