chart as a splash screen / popup

Cossie

Active Member
Joined
May 6, 2002
Messages
328
I have a chart in a workbook that i want to make appear when you hit a command button, stay for 10 seconds and then disappear.

Any suggestions would be welcome?
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
OK, this is going to be a long post.

What you need.

1. A userform called (mine's called Userform1) with an Image control on it, mine's called Image1.
2. A chart on the active worksheet (mine's called "Chart 2"
3. A button on the worksheet that runs the code to show the userform, i.e. the click event has this code:

<pre> UserForm1.Show</pre>

4. A standard code module.

OK, in the standard module copy and paste this code:

<pre>
'***************************************************************************
'*
'* MODULE NAME: Paste Picture
'* AUTHOR & DATE: STEPHEN BULLEN, Business Modelling Solutions Ltd.
'* 15 November 1998
'*
'* CONTACT: Stephen@BMSLtd.co.uk
'* WEB SITE: http://www.BMSLtd.co.uk
'*
'* DESCRIPTION: Creates a standard Picture object from whatever is on the clipboard.
'* This object can then be assigned to (for example) and Image control
'* on a userform. The PastePicture function takes an optional argument of
'* the picture type - xlBitmap or xlPicture.
'*
'* The code requires a reference to the "OLE Automation" type library
'*
'* The code in this module has been derived from a number of sources
'* discovered on MSDN.
'*
'* To use it, just copy this module into your project, then you can use:
'* Set Image1.Picture = PastePicture(xlPicture)
'* to paste a picture of whatever is on the clipboard into a standard image control.
'*
'* PROCEDURES:
'* PastePicture The entry point for the routine
'* CreatePicture Private function to convert a bitmap or metafile handle to an OLE reference
'* fnOLEError Get the error text for an OLE error code
'***************************************************************************

Option Explicit
Option Compare Text

''' User-Defined Types for API Calls

'Declare a UDT to store a GUID for the IPicture OLE Interface
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

'Declare a UDT to store the bitmap information
Private Type uPicDesc
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type

'''Windows API Function Declarations

'Does the clipboard contain a bitmap/metafile?
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long

'Open the clipboard to read
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long

'Get a pointer to the bitmap/metafile
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long

'Close the clipboard
Private Declare Function CloseClipboard Lib "user32" () As Long

'Convert the handle into an OLE IPicture interface.
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long

'Create our own copy of the metafile, so it doesn't get wiped out by subsequent clipboard updates.
Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long

'Create our own copy of the bitmap, so it doesn't get wiped out by subsequent clipboard updates.
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

'The API format types we're interested in
Const CF_BITMAP = 2
Const CF_PALETTE = 9
Const CF_ENHMETAFILE = 14
Const IMAGE_BITMAP = 0
Const LR_COPYRETURNORG = &H4

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Subroutine: PastePicture
'''
''' Purpose: Get a Picture object showing whatever's on the clipboard.
'''
''' Arguments: lXlPicType - The type of picture to create. Can be one of:
''' xlPicture to create a metafile (default)
''' xlBitmap to create a bitmap
'''
''' Date Developer Action
''' --------------------------------------------------------------------------
''' 30 Oct 98 Stephen Bullen Created
''' 15 Nov 98 Stephen Bullen Updated to create our own copies of the clipboard images
'''

Function PastePicture(Optional lXlPicType As Long = xlPicture) As IPicture

'Some pointers
Dim h As Long, hPicAvail As Long, hPtr As Long, hPal As Long, lPicType As Long, hCopy As Long

'Convert the type of picture requested from the xl constant to the API constant
lPicType = IIf(lXlPicType = xlBitmap, CF_BITMAP, CF_ENHMETAFILE)

'Check if the clipboard contains the required format
hPicAvail = IsClipboardFormatAvailable(lPicType)

If hPicAvail <> 0 Then
'Get access to the clipboard
h = OpenClipboard(0&)

If h > 0 Then
'Get a handle to the image data
hPtr = GetClipboardData(lPicType)

'Create our own copy of the image on the clipboard, in the appropriate format.
If lPicType = CF_BITMAP Then
hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
Else
hCopy = CopyEnhMetaFile(hPtr, vbNullString)
End If

'Release the clipboard to other programs
h = CloseClipboard

'If we got a handle to the image, convert it into a Picture object and return it
If hPtr <> 0 Then Set PastePicture = CreatePicture(hCopy, 0, lPicType)
End If
End If

End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Subroutine: CreatePicture
'''
''' Purpose: Converts a image (and palette) handle into a Picture object.
'''
''' Requires a reference to the "OLE Automation" type library
'''
''' Arguments: None
'''
''' Date Developer Action
''' --------------------------------------------------------------------------
''' 30 Oct 98 Stephen Bullen Created
'''

Private Function CreatePicture(ByVal hPic As Long, ByVal hPal As Long, ByVal lPicType) As IPicture

' IPicture requires a reference to "OLE Automation"
Dim r As Long, uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPicture

'OLE Picture types
Const PICTYPE_BITMAP = 1
Const PICTYPE_ENHMETAFILE = 4

' Create the Interface GUID (for the IPicture interface)
With IID_IDispatch
.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

' Fill uPicInfo with necessary parts.
With uPicInfo
.Size = Len(uPicInfo) ' Length of structure.
.Type = IIf(lPicType = CF_BITMAP, PICTYPE_BITMAP, PICTYPE_ENHMETAFILE) ' Type of Picture
.hPic = hPic ' Handle to image.
.hPal = IIf(lPicType = CF_BITMAP, hPal, 0) ' Handle to palette (if bitmap).
End With

' Create the Picture object.
r = OleCreatePictureIndirect(uPicInfo, IID_IDispatch, True, IPic)

' If an error occured, show the description
If r <> 0 Then Debug.Print "Create Picture: " & fnOLEError(r)

' Return the new Picture object.
Set CreatePicture = IPic

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Subroutine: fnOLEError
'''
''' Purpose: Gets the message text for standard OLE errors
'''
''' Arguments: None
'''
''' Date Developer Action
''' --------------------------------------------------------------------------
''' 30 Oct 98 Stephen Bullen Created
'''

Private Function fnOLEError(lErrNum As Long) As String

'OLECreatePictureIndirect return values
Const E_ABORT = &H80004004
Const E_ACCESSDENIED = &H80070005
Const E_FAIL = &H80004005
Const E_HANDLE = &H80070006
Const E_INVALIDARG = &H80070057
Const E_NOINTERFACE = &H80004002
Const E_NOTIMPL = &H80004001
Const E_OUTOFMEMORY = &H8007000E
Const E_POINTER = &H80004003
Const E_UNEXPECTED = &H8000FFFF
Const S_OK = &H0

Select Case lErrNum
Case E_ABORT
fnOLEError = " Aborted"
Case E_ACCESSDENIED
fnOLEError = " Access Denied"
Case E_FAIL
fnOLEError = " General Failure"
Case E_HANDLE
fnOLEError = " Bad/Missing Handle"
Case E_INVALIDARG
fnOLEError = " Invalid Argument"
Case E_NOINTERFACE
fnOLEError = " No Interface"
Case E_NOTIMPL
fnOLEError = " Not Implemented"
Case E_OUTOFMEMORY
fnOLEError = " Out of Memory"
Case E_POINTER
fnOLEError = " Invalid Pointer"
Case E_UNEXPECTED
fnOLEError = " Unknown Error"
Case S_OK
fnOLEError = " Success!"
End Select

End Function</pre>

On the userform, put this code:

<pre>

Private Sub UserForm_Activate()
Application.Wait Now + TimeValue("0:00:10")
Unload Me
End Sub

Private Sub UserForm_Initialize()
ActiveSheet.Shapes("Chart 2").CopyPicture
Me.Image1.Picture = PastePicture
End Sub</pre>

OK, that's all you need. Click your button and the form should show with the graph on the image control. If you need to get rid of the title bar on the userform, search this board. If you can't find it just repost.

HTH

And if there's any problems, just repost. (Oh yeah, to get the graph to automatically size to fit the Image control, go into the code version of the USerform and click on the Image control, hit "F4" to get the properties window up. Scroll down in the properties window and find the property called "PictureSizeMode" set this to option 1, "fmPictureSizeModeStretch")

Phew!
 
Upvote 0
Mark

that was a mammoth effort Thanks for the time you took to put that together.

The only problem so far is that it stops at "chart 2"

Private Sub UserForm_Initialize()
ActiveSheet.Shapes("Chart 2").CopyPicture
Me.Image1.Picture = PastePicture
End Sub

Is there something i am doing wrong?
this site is awesome!!
 
Upvote 0
You need to change "Chart 2" to whatever the name of your chart is.

To find out hold down CTRL and Click on your graph. The combo box to the left of the formula bar will show the name of the chart.

PS. The original post only took 10 minutes to knock together. :biggrin: I've had to do something similar before.
 
Upvote 0
On 2002-05-09 17:25, Cossie wrote:
I have a chart in a workbook that i want to make appear when you hit a command button, stay for 10 seconds and then disappear.

Any suggestions would be welcome?

Hi Cossie
Not to take away from Mark but another
easier option is to just make your chart
visible/Not Visible via the command button ?
The Chart after all is just an Object and most excel objects have the Visible property.


If you know the name of the Chart then;

<pre/>
Sub showChart()
Dim Ch As Object

'//Change [Chart 1] to the name of your Chart
Set Ch = ActiveSheet.Shapes("Chart 1")

Ch.Visible = Not (Ch.Visible)
DoEvents
Application.Wait Now + TimeValue("00:00:10")
Ch.Visible = Not (Ch.Visible)

Set Ch = Nothing
End Sub

</pre>


:biggrin:
 
Upvote 0
Thanks Ivan

The code runs, but the chart remains visible the whole time.

Do i need to do something else.

Thnaks for your assistance
 
Upvote 0
On 2002-05-12 17:05, Cossie wrote:
Thanks Ivan

The code runs, but the chart remains visible the whole time.

Do i need to do something else.

Thnaks for your assistance

try this;

Sub showChart()
Dim Ch As Object

'//Change [Chart 1] to the name of your Chart
Set Ch = ActiveSheet.Shapes("Chart 1")

Ch.Visible = True
DoEvents
Application.Wait Now + TimeValue("00:00:10")
Ch.Visible = False

Set Ch = Nothing
End Sub
 
Upvote 0
Ivan

That runs the code and i get a flash of the chart at the end - but not for 10 seconds more like less than 1 sec.

thanks for you assistance
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,184
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top