Picture in spreadsheet to picture in userform?

C

Charlotte E.

I have a picture on a spreadsheet, which I know the name of,
ActiveSheet.Shapes("Picture 1")

I would like to show this picture in a userform, in Image1


But how???


I've tried Image1.Picture = LoadPicture(ActiveSheet.Shapes("Picture 1"))

....but that one didn't work :-(


How to show a picture from a spreadsheet in a userform???

Is it possible to temporary save/export the picture in the spreadsheet, and
then use LoadPicture to get it???


How to do it???


TIA,
CE
 
J

john

behind the form try:

Dim SheetPicture As Image
With ThisWorkbook.Worksheets("mysheet")

Set SheetPicture = .Image1

Image1.Picture = SheetPicture.Picture

End with
 
C

Charlotte E.

Sorry, John - not working ...

behind the form try:

Dim SheetPicture As Image
With ThisWorkbook.Worksheets("mysheet")

Set SheetPicture = .Image1

Image1.Picture = SheetPicture.Picture

End with
 
D

Dave Peterson

I saved this from a previous post. You may be able to pick out what you need:

I put 5 pictures in Sheet1.

They were named "Picture 1", "Picture 2", ..., "Picture 5" (note the space
character).

Then I created a small userform with 2 commandbuttons (commandbutton1 and
commandbutton2) and a single image control (Image1).

This code goes in a General module:

Option Explicit
Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(8) As Byte
End Type

Type PICTDESC
cbSize As Long
picType As Long
hImage As Long
End Type

Declare Function OpenClipboard& Lib "user32" (ByVal hwnd As Long)
Declare Function GetClipboardData& Lib "user32" (ByVal wFormat%)
Declare Function CloseClipboard& Lib "user32" ()
Declare Function CopyImage& Lib "user32" (ByVal handle& _
, ByVal un1&, ByVal n1&, ByVal n2&, ByVal un2&)
Declare Function IIDFromString Lib "ole32" (ByVal lpsz As String _
, ByRef lpiid As GUID) As Long
Declare Function OleCreatePictureIndirect Lib "olepro32" _
(pPictDesc As PICTDESC, ByRef riid As GUID, ByVal fOwn As Long _
, ByRef ppvObj As IPicture) As Long

' picTypeConstants:
' None = 0 / Bitmap = 1 / Metafile = 2 / Icon = 3 / EMetafile = 4



This code goes behind the userform:

Option Explicit
Dim WhichImage As Long
Private Sub CommandButton1_Click()
'Prev button
WhichImage = WhichImage - 1
If WhichImage = 0 Then
WhichImage = 5
End If
Call DoTheWork(WhichPicNumber:=WhichImage)
End Sub
Private Sub CommandButton2_Click()
'Next button
WhichImage = WhichImage + 1
If WhichImage = 6 Then
WhichImage = 1
End If
Call DoTheWork(WhichPicNumber:=WhichImage)
End Sub
Private Sub UserForm_Initialize()
With Me.CommandButton1
.Caption = "Prev"
End With

With Me.CommandButton2
.Caption = "Next"
End With
End Sub
Sub DoTheWork(WhichPicNumber As Long)
ThisWorkbook.Worksheets("Sheet1") _
.Shapes("Picture " & WhichPicNumber).CopyPicture xlScreen, xlBitmap
Dim hCopy&
OpenClipboard 0&
hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H4)
CloseClipboard
If hCopy = 0 Then Exit Sub
Const IPictureIID = "{7BF80981-BF32-101A-8BBB-00AA00300CAB}"
Dim iPic As IPicture, tIID As GUID, tPICTDEST As PICTDESC, Ret&
Ret = IIDFromString(StrConv(IPictureIID, vbUnicode), tIID)
If Ret Then Exit Sub
With tPICTDEST
.cbSize = Len(tPICTDEST)
.picType = 1
.hImage = hCopy
End With
Ret = OleCreatePictureIndirect(tPICTDEST, tIID, 1, iPic)
If Ret Then Exit Sub
Me.Image1.Picture = iPic
'UserForm1.Image1.Picture = IPic
Set iPic = Nothing
' UserForm1.Show
End Sub

=================
The code that does all the real work is from Michel Pierron's post:
http://groups.google.co.uk/group/mi...d/dd2a46f0258b86b8?lnk=st&q=#dd2a46f0258b86b8

or

http://snipurl.com/30v2c [groups_google_co_uk]
 
J

john

Charlotte,
sorry, but I just assumed that you had an image control on your worksheet -
code works ok with that.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top