Graphique feuille excel -> Userform

Bonjour Laurent,

Je ne crois pas que cela soit possible avec une macro.

Cependant, tu peux sélectionner ton image dans ta feuille,
aller dans ton formulaire en mode création et effectuer un coller Ctrl + V
directement dans le contrôle "Picture" de ton formulaire.


Généralement, Les images sont stockées dans un répertoire et lorsque l'on veut afficher une image, on passa la ligne de
commande suivante :

Me.Image1.Picture = LoadPicture("C:WinntJour de pêche.bmp")


Salutations!


"Laurent Lassasseigne" <lassass@wanadoo.fr> a écrit dans le message de news:c0odip$q53$1@news-reader5.wanadoo.fr...
Bonsoir.

Voilà ce que je veux faire :
Dans une page d'un classeur EXCEL, j'ai copié pleins d'images.
Mon but, c'est de faire en vba une routine qui vient piocher une de ses
images, et le balourde dans un cadre graphique d'un userform. Un
'copier-coller' d'une feuille vers le userform quoi.
J'ai recherché un peu partout, la seule possibilité que j'ai apparemment,
c'est d'indiquer un chemin pour le graphique dans la propriété 'Picture' du
cadre du Userform, impossible d'y mettre une référence du style
activesheet.shapes("Picture 1").
Une autre solution serait de créer autant d'userform que j'ai d'image, et
d'appeller le userform avec l'image dont j'ai besoin, mais c'est lourd et
pas pratique pour moi.

Quelqu'un a une idée ?

"michdenis" <michdenis@hotmail.com> a écrit dans le message news:
eLrAuX$8DHA.4060@tk2msftngp13.phx.gbl...

Bonjour Laurent,

Je ne crois pas que cela soit possible avec une macro.


Généralement, Les images sont stockées dans un répertoire et lorsque l'on
veut afficher une image, on passa la ligne de

commande suivante :

Merci de ta réponse.

Je connaissais bien cette info du CTRL+V, mais c'est justement pour éviter
les soucis d'arborescence que j'ai intégré directement mes images dans mon
classeur. Je veux une portabilité sans problème (envoi par mail, utilisation
par des novices pour qui une mauvaise installation dans un répertoire
pourrait devenir une grosse galère).

C'est étonnant que l'on puisse pas faire une référence en VBA dans ce champ
picture quand même.

Bonsoir Laurent;
Il t'aurait été aussi facile d'avoir le chemin des images sur une feuille et
d'utiliser LoadPicture(Sheets(u).cells(x,y))
MP

"Laurent Lassasseigne" <lassass@wanadoo.fr> a écrit dans le message de
news:c0odip$q53$1@news-reader5.wanadoo.fr...

Bonsoir.

Voilà ce que je veux faire :
Dans une page d'un classeur EXCEL, j'ai copié pleins d'images.
Mon but, c'est de faire en vba une routine qui vient piocher une de ses
images, et le balourde dans un cadre graphique d'un userform. Un
'copier-coller' d'une feuille vers le userform quoi.
J'ai recherché un peu partout, la seule possibilité que j'ai apparemment,
c'est d'indiquer un chemin pour le graphique dans la propriété 'Picture'
du

cadre du Userform, impossible d'y mettre une référence du style
activesheet.shapes("Picture 1").
Une autre solution serait de créer autant d'userform que j'ai d'image, et
d'appeller le userform avec l'image dont j'ai besoin, mais c'est lourd et
pas pratique pour moi.

Quelqu'un a une idée ?

Re Laurent;
Tu peux aussi placer tes images dans des contrôles image situés en dehors de
la zône d'affichage de ton userform et utiliser:
Me.Image1.Picture = Me.Image("X").Picture où X correspond au nom du contrôle
contenant l'image à afficher.
MP

"Laurent Lassasseigne" <lassass@wanadoo.fr> a écrit dans le message de
news:c0odip$q53$1@news-reader5.wanadoo.fr...

Bonsoir.

Voilà ce que je veux faire :
Dans une page d'un classeur EXCEL, j'ai copié pleins d'images.
Mon but, c'est de faire en vba une routine qui vient piocher une de ses
images, et le balourde dans un cadre graphique d'un userform. Un
'copier-coller' d'une feuille vers le userform quoi.
J'ai recherché un peu partout, la seule possibilité que j'ai apparemment,
c'est d'indiquer un chemin pour le graphique dans la propriété 'Picture'
du

cadre du Userform, impossible d'y mettre une référence du style
activesheet.shapes("Picture 1").
Une autre solution serait de créer autant d'userform que j'ai d'image, et
d'appeller le userform avec l'image dont j'ai besoin, mais c'est lourd et
pas pratique pour moi.

Quelqu'un a une idée ?

Bonjour Laurent;
Moyennant quelques API, tu peux sauvegarder sur le disque, l'image à copier au
format Bmp par l'intermédiaire du pressse-papiers et ensuite charger ce fichier
dans ton contrôle image avant de détruire la copie de l'image. Au passage, la
méthode peut être utilisée pour sauvegarder les images d'une feuille au format
Bmp.
Exemple:
Option Explicit
Private Declare Function IsClipboardFormatAvailable Lib _
"user32" (ByVal wFormat As Integer) As Long
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" _
(ByVal wFormat As Integer) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
(PicDesc As uPicDesc, RefIID As GUID _
, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function CopyImage Lib "user32" (ByVal handle As Long _
, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long _
, ByVal un2 As Long) As Long
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type uPicDesc
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type

Private Function PasteBmp() As IPicture
Dim hCopy As Long
If IsClipboardFormatAvailable(2) Then
If OpenClipboard(0&) Then
hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H4)
CloseClipboard
If hCopy Then Set PasteBmp = CreateBmp(hCopy, 0, 2)
End If
End If
End Function

' IPicture requires a reference to "OLE Automation"
Private Function CreateBmp(ByVal hPic As Long, ByVal hPal As Long, ByVal lPicType)
As IPicture
Dim i As Long, PicInfo As uPicDesc, OlePicStore As GUID, IPic As IPicture
With OlePicStore
.Data1 = &H7BF80980: .Data2 = &HBF32: .Data3 = &H101A
For i = 1 To 8
.Data4(i - 1) = Choose(i, &H8B, &HBB, &H0, &HAA, &H0, &H30, &HC, &HAB)
Next i
End With
With PicInfo
.Size = Len(PicInfo)
.Type = 1
.hPic = hPic
.hPal = hPal
End With
If OleCreatePictureIndirect(PicInfo, OlePicStore, True, IPic) Then
MsgBox "Impossible de créer le bitmap !", 48
End If
Set CreateBmp = IPic
End Function

Sub SaveBmp(Optional idx As Integer = 1)
On Error GoTo Fin
Dim oPic As IPictureDisp, BmpFile As String
ThisWorkbook.Sheets(1).Shapes("Picture " & idx).CopyPicture xlScreen, xlBitmap
BmpFile = ThisWorkbook.Path & "Temp.bmp"
Set oPic = PasteBmp: SavePicture oPic, BmpFile
UserForm1.Image1.Picture = LoadPicture(BmpFile)
Kill BmpFile: Set oPic = Nothing
Exit Sub
Fin: MsgBox "Image non trouvée !", 48
End Sub

MP

"Laurent Lassasseigne" <lassass@wanadoo.fr> a écrit dans le message de
news:c0odip$q53$1@news-reader5.wanadoo.fr...

Bonsoir.

Voilà ce que je veux faire :
Dans une page d'un classeur EXCEL, j'ai copié pleins d'images.
Mon but, c'est de faire en vba une routine qui vient piocher une de ses
images, et le balourde dans un cadre graphique d'un userform. Un
'copier-coller' d'une feuille vers le userform quoi.
J'ai recherché un peu partout, la seule possibilité que j'ai apparemment,
c'est d'indiquer un chemin pour le graphique dans la propriété 'Picture' du
cadre du Userform, impossible d'y mettre une référence du style
activesheet.shapes("Picture 1").
Une autre solution serait de créer autant d'userform que j'ai d'image, et
d'appeller le userform avec l'image dont j'ai besoin, mais c'est lourd et
pas pratique pour moi.

Quelqu'un a une idée ?

Bonjour Michel,

Bravo ! Ta procédure fonctionne très bien.

Je ne vais pas te demander de la commenter ligne par ligne ;-))
mais en la testant, je suis demeurer perplexe.

Voilà j'ai appelé toute la procédure soumise par cette ligne de code :

SaveBmp 1

Je pensais que le 1 était l'index de l'image dans l'appellation du nom de l'image. Cependant après avoir faire varier le
nom de l'image et de son index, le 1 "semble" représenter plutôt l'index retenu par excel quant à l'ordre avec lequel
l'objet "image" a été créé sur la feuille

Ma question: Comment fait-on pour pouvoir déceler cet ordre? La feuille de calcul possède la propriété "CodeName" qui
nous met à l'abri de la modification des noms des onglets de la feuille. Existe-t-il l'équivalent pour les images créées
dans une feuille de calcul ?

Merci pour ta collaboration. Et encore merci pour cette solution.


Salutations!


"Michel Pierron" <mpierron@europtest.com> a écrit dans le message de news:uKo58uG9DHA.2752@TK2MSFTNGP09.phx.gbl...
Bonjour Laurent;
Moyennant quelques API, tu peux sauvegarder sur le disque, l'image à copier au
format Bmp par l'intermédiaire du pressse-papiers et ensuite charger ce fichier
dans ton contrôle image avant de détruire la copie de l'image. Au passage, la
méthode peut être utilisée pour sauvegarder les images d'une feuille au format
Bmp.
Exemple:
Option Explicit
Private Declare Function IsClipboardFormatAvailable Lib _
"user32" (ByVal wFormat As Integer) As Long
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" _
(ByVal wFormat As Integer) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
(PicDesc As uPicDesc, RefIID As GUID _
, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function CopyImage Lib "user32" (ByVal handle As Long _
, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long _
, ByVal un2 As Long) As Long
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type uPicDesc
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type

Private Function PasteBmp() As IPicture
Dim hCopy As Long
If IsClipboardFormatAvailable(2) Then
If OpenClipboard(0&) Then
hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H4)
CloseClipboard
If hCopy Then Set PasteBmp = CreateBmp(hCopy, 0, 2)
End If
End If
End Function

' IPicture requires a reference to "OLE Automation"
Private Function CreateBmp(ByVal hPic As Long, ByVal hPal As Long, ByVal lPicType)
As IPicture
Dim i As Long, PicInfo As uPicDesc, OlePicStore As GUID, IPic As IPicture
With OlePicStore
.Data1 = &H7BF80980: .Data2 = &HBF32: .Data3 = &H101A
For i = 1 To 8
.Data4(i - 1) = Choose(i, &H8B, &HBB, &H0, &HAA, &H0, &H30, &HC, &HAB)
Next i
End With
With PicInfo
.Size = Len(PicInfo)
.Type = 1
.hPic = hPic
.hPal = hPal
End With
If OleCreatePictureIndirect(PicInfo, OlePicStore, True, IPic) Then
MsgBox "Impossible de créer le bitmap !", 48
End If
Set CreateBmp = IPic
End Function

Sub SaveBmp(Optional idx As Integer = 1)
On Error GoTo Fin
Dim oPic As IPictureDisp, BmpFile As String
ThisWorkbook.Sheets(1).Shapes("Picture " & idx).CopyPicture xlScreen, xlBitmap
BmpFile = ThisWorkbook.Path & "Temp.bmp"
Set oPic = PasteBmp: SavePicture oPic, BmpFile
UserForm1.Image1.Picture = LoadPicture(BmpFile)
Kill BmpFile: Set oPic = Nothing
Exit Sub
Fin: MsgBox "Image non trouvée !", 48
End Sub

MP

"Laurent Lassasseigne" <lassass@wanadoo.fr> a écrit dans le message de
news:c0odip$q53$1@news-reader5.wanadoo.fr...

Bonsoir.

Voilà ce que je veux faire :
Dans une page d'un classeur EXCEL, j'ai copié pleins d'images.
Mon but, c'est de faire en vba une routine qui vient piocher une de ses
images, et le balourde dans un cadre graphique d'un userform. Un
'copier-coller' d'une feuille vers le userform quoi.
J'ai recherché un peu partout, la seule possibilité que j'ai apparemment,
c'est d'indiquer un chemin pour le graphique dans la propriété 'Picture' du
cadre du Userform, impossible d'y mettre une référence du style
activesheet.shapes("Picture 1").
Une autre solution serait de créer autant d'userform que j'ai d'image, et
d'appeller le userform avec l'image dont j'ai besoin, mais c'est lourd et
pas pratique pour moi.

Quelqu'un a une idée ?

Bonjour Denis;
Tu as vu juste; l'index correspond à l'index chronologique attribué par Excel au
moment de l'insertion de l'image sur la feuille (Picture x). Cela marcherait aussi
avec l'index seul, mais l'avantage de la première solution est de pouvoir isoler
les images concernées en éliminant les images indésirables; il suffit de les
renommer par exemple img1, img2, etc. et l'appel devient:
ThisWorkbook.Sheets(1).Shapes("img" & idx).CopyPicture xlScreen, xlBitmap

Les valeurs indiquées pour Private Type GUID ne servent qu'à écrire un identifiant
unique pour l'interface IPicture (fill in magic IPicture GUID
{7BF80980-BF32-101A-8BBB-00AA00300CAB}.

MP

"michdenis" <michdenis@hotmail.com> a écrit dans le message de
news:OV6OMII9DHA.400@tk2msftngp13.phx.gbl...

Bonjour Michel,

Bravo ! Ta procédure fonctionne très bien.

Je ne vais pas te demander de la commenter ligne par ligne ;-))
mais en la testant, je suis demeurer perplexe.

Voilà j'ai appelé toute la procédure soumise par cette ligne de code :

SaveBmp 1

Je pensais que le 1 était l'index de l'image dans l'appellation du nom de
l'image. Cependant après avoir faire varier le

nom de l'image et de son index, le 1 "semble" représenter plutôt l'index retenu
par excel quant à l'ordre avec lequel

l'objet "image" a été créé sur la feuille

Ma question: Comment fait-on pour pouvoir déceler cet ordre? La feuille de
calcul possède la propriété "CodeName" qui

nous met à l'abri de la modification des noms des onglets de la feuille.
Existe-t-il l'équivalent pour les images créées

dans une feuille de calcul ?

Merci pour ta collaboration. Et encore merci pour cette solution.


Salutations!


"Michel Pierron" <mpierron@europtest.com> a écrit dans le message de
news:uKo58uG9DHA.2752@TK2MSFTNGP09.phx.gbl...

Bonjour Laurent;
Moyennant quelques API, tu peux sauvegarder sur le disque, l'image à copier au
format Bmp par l'intermédiaire du pressse-papiers et ensuite charger ce fichier
dans ton contrôle image avant de détruire la copie de l'image. Au passage, la
méthode peut être utilisée pour sauvegarder les images d'une feuille au format
Bmp.
Exemple:
Option Explicit
Private Declare Function IsClipboardFormatAvailable Lib _
"user32" (ByVal wFormat As Integer) As Long
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" _
(ByVal wFormat As Integer) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
(PicDesc As uPicDesc, RefIID As GUID _
, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function CopyImage Lib "user32" (ByVal handle As Long _
, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long _
, ByVal un2 As Long) As Long
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type uPicDesc
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type

Private Function PasteBmp() As IPicture
Dim hCopy As Long
If IsClipboardFormatAvailable(2) Then
If OpenClipboard(0&) Then
hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H4)
CloseClipboard
If hCopy Then Set PasteBmp = CreateBmp(hCopy, 0, 2)
End If
End If
End Function

' IPicture requires a reference to "OLE Automation"
Private Function CreateBmp(ByVal hPic As Long, ByVal hPal As Long, ByVal
lPicType)

As IPicture
Dim i As Long, PicInfo As uPicDesc, OlePicStore As GUID, IPic As IPicture
With OlePicStore
.Data1 = &H7BF80980: .Data2 = &HBF32: .Data3 = &H101A
For i = 1 To 8
.Data4(i - 1) = Choose(i, &H8B, &HBB, &H0, &HAA, &H0, &H30, &HC, &HAB)
Next i
End With
With PicInfo
.Size = Len(PicInfo)
.Type = 1
.hPic = hPic
.hPal = hPal
End With
If OleCreatePictureIndirect(PicInfo, OlePicStore, True, IPic) Then
MsgBox "Impossible de créer le bitmap !", 48
End If
Set CreateBmp = IPic
End Function

Sub SaveBmp(Optional idx As Integer = 1)
On Error GoTo Fin
Dim oPic As IPictureDisp, BmpFile As String
ThisWorkbook.Sheets(1).Shapes("Picture " & idx).CopyPicture xlScreen, xlBitmap
BmpFile = ThisWorkbook.Path & "Temp.bmp"
Set oPic = PasteBmp: SavePicture oPic, BmpFile
UserForm1.Image1.Picture = LoadPicture(BmpFile)
Kill BmpFile: Set oPic = Nothing
Exit Sub
Fin: MsgBox "Image non trouvée !", 48
End Sub

MP

"Laurent Lassasseigne" <lassass@wanadoo.fr> a écrit dans le message de
news:c0odip$q53$1@news-reader5.wanadoo.fr...

Bonsoir.

Voilà ce que je veux faire :
Dans une page d'un classeur EXCEL, j'ai copié pleins d'images.
Mon but, c'est de faire en vba une routine qui vient piocher une de ses
images, et le balourde dans un cadre graphique d'un userform. Un
'copier-coller' d'une feuille vers le userform quoi.
J'ai recherché un peu partout, la seule possibilité que j'ai apparemment,
c'est d'indiquer un chemin pour le graphique dans la propriété 'Picture' du
cadre du Userform, impossible d'y mettre une référence du style
activesheet.shapes("Picture 1").
Une autre solution serait de créer autant d'userform que j'ai d'image, et
d'appeller le userform avec l'image dont j'ai besoin, mais c'est lourd et
pas pratique pour moi.

Quelqu'un a une idée ?

Bonjour Michel,
trés intéressé par ta macro,
notament par la partie image de feuille.....

de la même façon que l'on faisait cela trés facilement
avec une boite de dialogue
exemple:
Sub Macro1()
Sheets("Dialogue1").Select
ActiveSheet.Shapes("monImage").Select
Selection.Formula = "Feuil1!D6:G12"
End Sub
j'ai vainement essayé de transposer tes macros à un
userform.

comment rendre cette image dynamique,
doit-on obligatoirement passer par un bitmap
enregistré ????

;-)
@+

-----Message d'origine-----
Bonjour Laurent;
Moyennant quelques API, tu peux sauvegarder sur le
disque, l'image à copier au

format Bmp par l'intermédiaire du pressse-papiers et
ensuite charger ce fichier

dans ton contrôle image avant de détruire la copie de
l'image. Au passage, la

méthode peut être utilisée pour sauvegarder les images
d'une feuille au format

Bmp.
Exemple:
Option Explicit
Private Declare Function IsClipboardFormatAvailable Lib _
"user32" (ByVal wFormat As Integer) As Long
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" _
(ByVal wFormat As Integer) As Long
Private Declare Function CloseClipboard Lib "user32" ()
As Long

Private Declare Function OleCreatePictureIndirect
Lib "olepro32.dll" _

(PicDesc As uPicDesc, RefIID As GUID _
, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As
Long

Private Declare Function CopyImage Lib "user32" (ByVal
handle As Long _

, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long _
, ByVal un2 As Long) As Long
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type uPicDesc
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type

Private Function PasteBmp() As IPicture
Dim hCopy As Long
If IsClipboardFormatAvailable(2) Then
If OpenClipboard(0&) Then
hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H4)
CloseClipboard
If hCopy Then Set PasteBmp = CreateBmp(hCopy, 0, 2)
End If
End If
End Function

' IPicture requires a reference to "OLE Automation"
Private Function CreateBmp(ByVal hPic As Long, ByVal hPal
As Long, ByVal lPicType)

As IPicture
Dim i As Long, PicInfo As uPicDesc, OlePicStore As
GUID, IPic As IPicture

With OlePicStore
.Data1 = &H7BF80980: .Data2 = &HBF32: .Data3 = &H101A
For i = 1 To 8
.Data4(i - 1) = Choose(i, &H8B, &HBB, &H0, &HAA,
&H0, &H30, &HC, &HAB)

Next i
End With
With PicInfo
.Size = Len(PicInfo)
.Type = 1
.hPic = hPic
.hPal = hPal
End With
If OleCreatePictureIndirect(PicInfo, OlePicStore, True,
IPic) Then

MsgBox "Impossible de créer le bitmap !", 48
End If
Set CreateBmp = IPic
End Function

Sub SaveBmp(Optional idx As Integer = 1)
On Error GoTo Fin
Dim oPic As IPictureDisp, BmpFile As String
ThisWorkbook.Sheets(1).Shapes("Picture " &
idx).CopyPicture xlScreen, xlBitmap

BmpFile = ThisWorkbook.Path & "Temp.bmp"
Set oPic = PasteBmp: SavePicture oPic, BmpFile
UserForm1.Image1.Picture = LoadPicture(BmpFile)
Kill BmpFile: Set oPic = Nothing
Exit Sub
Fin: MsgBox "Image non trouvée !", 48
End Sub

MP

"Laurent Lassasseigne" <lassass@wanadoo.fr> a écrit dans
le message de

news:c0odip$q53$1@news-reader5.wanadoo.fr...

Bonsoir.

Voilà ce que je veux faire :
Dans une page d'un classeur EXCEL, j'ai copié pleins
d'images.

Mon but, c'est de faire en vba une routine qui vient
piocher une de ses

images, et le balourde dans un cadre graphique d'un
userform. Un

'copier-coller' d'une feuille vers le userform quoi.
J'ai recherché un peu partout, la seule possibilité que
j'ai apparemment,

c'est d'indiquer un chemin pour le graphique dans la
propriété 'Picture' du

cadre du Userform, impossible d'y mettre une référence
du style

activesheet.shapes("Picture 1").
Une autre solution serait de créer autant d'userform
que j'ai d'image, et

d'appeller le userform avec l'image dont j'ai besoin,
mais c'est lourd et

pas pratique pour moi.

Quelqu'un a une idée ?

.

Bonjour Michel,

Ok, cela fonctionne. Merci.

J'ai l'impression que ta macro va faire bien des heureux !!!

Bonne journée,


Salutations!


"Michel Pierron" <mpierron@europtest.com> a écrit dans le message de news:uq%23X%23AJ9DHA.3704@tk2msftngp13.phx.gbl...
Bonjour Denis;
Tu as vu juste; l'index correspond à l'index chronologique attribué par Excel au
moment de l'insertion de l'image sur la feuille (Picture x). Cela marcherait aussi
avec l'index seul, mais l'avantage de la première solution est de pouvoir isoler
les images concernées en éliminant les images indésirables; il suffit de les
renommer par exemple img1, img2, etc. et l'appel devient:
ThisWorkbook.Sheets(1).Shapes("img" & idx).CopyPicture xlScreen, xlBitmap

Les valeurs indiquées pour Private Type GUID ne servent qu'à écrire un identifiant
unique pour l'interface IPicture (fill in magic IPicture GUID
{7BF80980-BF32-101A-8BBB-00AA00300CAB}.

MP

"michdenis" <michdenis@hotmail.com> a écrit dans le message de
news:OV6OMII9DHA.400@tk2msftngp13.phx.gbl...

Bonjour Michel,

Bravo ! Ta procédure fonctionne très bien.

Je ne vais pas te demander de la commenter ligne par ligne ;-))
mais en la testant, je suis demeurer perplexe.

Voilà j'ai appelé toute la procédure soumise par cette ligne de code :

SaveBmp 1

Je pensais que le 1 était l'index de l'image dans l'appellation du nom de
l'image. Cependant après avoir faire varier le

nom de l'image et de son index, le 1 "semble" représenter plutôt l'index retenu
par excel quant à l'ordre avec lequel

l'objet "image" a été créé sur la feuille

Ma question: Comment fait-on pour pouvoir déceler cet ordre? La feuille de
calcul possède la propriété "CodeName" qui

nous met à l'abri de la modification des noms des onglets de la feuille.
Existe-t-il l'équivalent pour les images créées

dans une feuille de calcul ?

Merci pour ta collaboration. Et encore merci pour cette solution.


Salutations!


"Michel Pierron" <mpierron@europtest.com> a écrit dans le message de
news:uKo58uG9DHA.2752@TK2MSFTNGP09.phx.gbl...

Bonjour Laurent;
Moyennant quelques API, tu peux sauvegarder sur le disque, l'image à copier au
format Bmp par l'intermédiaire du pressse-papiers et ensuite charger ce fichier
dans ton contrôle image avant de détruire la copie de l'image. Au passage, la
méthode peut être utilisée pour sauvegarder les images d'une feuille au format
Bmp.
Exemple:
Option Explicit
Private Declare Function IsClipboardFormatAvailable Lib _
"user32" (ByVal wFormat As Integer) As Long
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" _
(ByVal wFormat As Integer) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
(PicDesc As uPicDesc, RefIID As GUID _
, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function CopyImage Lib "user32" (ByVal handle As Long _
, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long _
, ByVal un2 As Long) As Long
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type uPicDesc
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type

Private Function PasteBmp() As IPicture
Dim hCopy As Long
If IsClipboardFormatAvailable(2) Then
If OpenClipboard(0&) Then
hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H4)
CloseClipboard
If hCopy Then Set PasteBmp = CreateBmp(hCopy, 0, 2)
End If
End If
End Function

' IPicture requires a reference to "OLE Automation"
Private Function CreateBmp(ByVal hPic As Long, ByVal hPal As Long, ByVal
lPicType)

As IPicture
Dim i As Long, PicInfo As uPicDesc, OlePicStore As GUID, IPic As IPicture
With OlePicStore
.Data1 = &H7BF80980: .Data2 = &HBF32: .Data3 = &H101A
For i = 1 To 8
.Data4(i - 1) = Choose(i, &H8B, &HBB, &H0, &HAA, &H0, &H30, &HC, &HAB)
Next i
End With
With PicInfo
.Size = Len(PicInfo)
.Type = 1
.hPic = hPic
.hPal = hPal
End With
If OleCreatePictureIndirect(PicInfo, OlePicStore, True, IPic) Then
MsgBox "Impossible de créer le bitmap !", 48
End If
Set CreateBmp = IPic
End Function

Sub SaveBmp(Optional idx As Integer = 1)
On Error GoTo Fin
Dim oPic As IPictureDisp, BmpFile As String
ThisWorkbook.Sheets(1).Shapes("Picture " & idx).CopyPicture xlScreen, xlBitmap
BmpFile = ThisWorkbook.Path & "Temp.bmp"
Set oPic = PasteBmp: SavePicture oPic, BmpFile
UserForm1.Image1.Picture = LoadPicture(BmpFile)
Kill BmpFile: Set oPic = Nothing
Exit Sub
Fin: MsgBox "Image non trouvée !", 48
End Sub

MP

"Laurent Lassasseigne" <lassass@wanadoo.fr> a écrit dans le message de
news:c0odip$q53$1@news-reader5.wanadoo.fr...

Bonsoir.

Voilà ce que je veux faire :
Dans une page d'un classeur EXCEL, j'ai copié pleins d'images.
Mon but, c'est de faire en vba une routine qui vient piocher une de ses
images, et le balourde dans un cadre graphique d'un userform. Un
'copier-coller' d'une feuille vers le userform quoi.
J'ai recherché un peu partout, la seule possibilité que j'ai apparemment,
c'est d'indiquer un chemin pour le graphique dans la propriété 'Picture' du
cadre du Userform, impossible d'y mettre une référence du style
activesheet.shapes("Picture 1").
Une autre solution serait de créer autant d'userform que j'ai d'image, et
d'appeller le userform avec l'image dont j'ai besoin, mais c'est lourd et
pas pratique pour moi.

Quelqu'un a une idée ?

Bonjour Modeste;
Peux-tu détailler un peu plus ton besoin que je cerne assez mal actuellement.
MP

"Modeste" <Gee-dee-@discussions.microsoft.com> a écrit dans le message de
news:1065401c3f491$54dd2440$a101280a@phx.gbl...
Bonjour Michel,
trés intéressé par ta macro,
notament par la partie image de feuille.....

de la même façon que l'on faisait cela trés facilement
avec une boite de dialogue
exemple:
Sub Macro1()
Sheets("Dialogue1").Select
ActiveSheet.Shapes("monImage").Select
Selection.Formula = "Feuil1!D6:G12"
End Sub
j'ai vainement essayé de transposer tes macros à un
userform.

comment rendre cette image dynamique,
doit-on obligatoirement passer par un bitmap
enregistré ????

;-)
@+

-----Message d'origine-----
Bonjour Laurent;
Moyennant quelques API, tu peux sauvegarder sur le
disque, l'image à copier au

format Bmp par l'intermédiaire du pressse-papiers et
ensuite charger ce fichier

dans ton contrôle image avant de détruire la copie de
l'image. Au passage, la

méthode peut être utilisée pour sauvegarder les images
d'une feuille au format

Bmp.
Exemple:
Option Explicit
Private Declare Function IsClipboardFormatAvailable Lib _
"user32" (ByVal wFormat As Integer) As Long
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" _
(ByVal wFormat As Integer) As Long
Private Declare Function CloseClipboard Lib "user32" ()
As Long

Private Declare Function OleCreatePictureIndirect
Lib "olepro32.dll" _

(PicDesc As uPicDesc, RefIID As GUID _
, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As
Long

Private Declare Function CopyImage Lib "user32" (ByVal
handle As Long _

, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long _
, ByVal un2 As Long) As Long
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type uPicDesc
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type

Private Function PasteBmp() As IPicture
Dim hCopy As Long
If IsClipboardFormatAvailable(2) Then
If OpenClipboard(0&) Then
hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H4)
CloseClipboard
If hCopy Then Set PasteBmp = CreateBmp(hCopy, 0, 2)
End If
End If
End Function

' IPicture requires a reference to "OLE Automation"
Private Function CreateBmp(ByVal hPic As Long, ByVal hPal
As Long, ByVal lPicType)

As IPicture
Dim i As Long, PicInfo As uPicDesc, OlePicStore As
GUID, IPic As IPicture

With OlePicStore
.Data1 = &H7BF80980: .Data2 = &HBF32: .Data3 = &H101A
For i = 1 To 8
.Data4(i - 1) = Choose(i, &H8B, &HBB, &H0, &HAA,
&H0, &H30, &HC, &HAB)

Next i
End With
With PicInfo
.Size = Len(PicInfo)
.Type = 1
.hPic = hPic
.hPal = hPal
End With
If OleCreatePictureIndirect(PicInfo, OlePicStore, True,
IPic) Then

MsgBox "Impossible de créer le bitmap !", 48
End If
Set CreateBmp = IPic
End Function

Sub SaveBmp(Optional idx As Integer = 1)
On Error GoTo Fin
Dim oPic As IPictureDisp, BmpFile As String
ThisWorkbook.Sheets(1).Shapes("Picture " &
idx).CopyPicture xlScreen, xlBitmap

BmpFile = ThisWorkbook.Path & "Temp.bmp"
Set oPic = PasteBmp: SavePicture oPic, BmpFile
UserForm1.Image1.Picture = LoadPicture(BmpFile)
Kill BmpFile: Set oPic = Nothing
Exit Sub
Fin: MsgBox "Image non trouvée !", 48
End Sub

MP

"Laurent Lassasseigne" <lassass@wanadoo.fr> a écrit dans
le message de

news:c0odip$q53$1@news-reader5.wanadoo.fr...

Bonsoir.

Voilà ce que je veux faire :
Dans une page d'un classeur EXCEL, j'ai copié pleins
d'images.

Mon but, c'est de faire en vba une routine qui vient
piocher une de ses

images, et le balourde dans un cadre graphique d'un
userform. Un

'copier-coller' d'une feuille vers le userform quoi.
J'ai recherché un peu partout, la seule possibilité que
j'ai apparemment,

c'est d'indiquer un chemin pour le graphique dans la
propriété 'Picture' du

cadre du Userform, impossible d'y mettre une référence
du style

activesheet.shapes("Picture 1").
Une autre solution serait de créer autant d'userform
que j'ai d'image, et

d'appeller le userform avec l'image dont j'ai besoin,
mais c'est lourd et

pas pratique pour moi.

Quelqu'un a une idée ?

.