NdNoviceHlp
Well-known Member
- Joined
- Nov 9, 2002
- Messages
- 3,768
I'm using a frame control to display a screen shot of a ws which includes an image control that displays a .gif of a chart. The problem is the frame control displays the current ws but does not display the current .gif. I've created a simulation with the following code. To trial, add an image contol(1) to sheet2 ("A1:E26") and add a userform(1) with a frame control(1) and a command button(1). Place the following code in a module..
Place the following code in the userform code..
To start use ...
Testing will show that the frame displays updated data but the chart shown is always the previous chart ie. the current chart is displayed in the image control but not in the frame control. I don't get it? I sure would like to if anyone has any suggestions. Dave
ps. It is Jaafar's code that I "borrowed" for the screen shot part
Code:
Option Explicit
Public ObjTargetRange As Range
Sub ChartFunction()
'charts function series(x6) on sheet 2
'creates series data for f(x) & charts on sheet2
'creates image of chart. Removes chart and series data
'loads image to sheet1 image control
Dim ChartRange As Range, Xvalue As Range, Yvalue As Range, Increment As Double
Dim Xmax As Double, Iter As Integer, Cnt As Integer, Fname As String
Dim TotSeries As Integer, Cnt2 As Integer, Cnt3 As Integer, Lastrow As Integer
Dim StartXmin As Double, Xval As Double, cnt6 As Integer
Application.ScreenUpdating = False
TotSeries = 3
Iter = 10 'Number of chart points
StartXmin = 0 '[sheet1!A1] ' "X" lowest value
Xmax = InputBox("Enter Max") '2 'highest "X" value
Increment = (Xmax - StartXmin) / (Iter - 1) 'chrt pt increments
'make "X" chart data (Sheet2 "A")
Sheets("Sheet2").Select
Sheets("Sheet2").UsedRange.Delete
Xval = StartXmin 'lowest "X" value
For cnt6 = 1 To Iter
Sheets("Sheet2").Cells(cnt6, 1) = Xval '"X" value
Xval = Xval + Increment
Next cnt6
'make "Y" chart data
' "Y" value generated by function for "X" value eg.f(x)#1: Exp(X) * Sin(X) ^ 2
StartXmin = 0 'set to 0 for 1st series
For Cnt2 = 2 To TotSeries + 1
For Cnt = 1 To Iter
Xval = Sheets("Sheet2").Cells(Cnt, 1) + StartXmin
Sheets("Sheet2").Cells(Cnt, Cnt2) = Exp(Xval) * Sin(Xval) ^ 2 'eg. f(x)#1
'Sheets("Sheet2").Cells(Cnt, Cnt2) = Exp(Xval) * Sin(Xval ^ 2) 'eg. f(x)#2
'Sheets("Sheet2").Cells(Cnt, Cnt2) = 2 * Sin(3 * Xval) + 8 ' eg. f(x)#3
Next Cnt
StartXmin = StartXmin + 0.25 ' changes "Y" value/location of line
Next Cnt2
'make chart
'use named range to chart 1st series
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet2"
ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
Lastrow = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, 1).End(xlUp).Row
Set Xvalue = Sheets("Sheet2").Cells(1, 1)
Set Yvalue = Sheets("Sheet2").Cells(Lastrow, 2)
Set ChartRange = Sheets("Sheet2").Range(Xvalue, Yvalue)
ActiveChart.SetSourceData Source:=ChartRange, PlotBy:=xlColumns
'add chart series
For Cnt3 = 3 To TotSeries + 1
Lastrow = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, Cnt3).End(xlUp).Row
ActiveChart.SeriesCollection.Add Source:=Sheets("Sheet2").Range(Sheets("Sheet2").Cells(1, Cnt3), _
Sheets("Sheet2").Cells(Lastrow, Cnt3)), _
Rowcol:=xlColumns, SeriesLabels:=False, CategoryLabels:=False, Replace:=False
Next Cnt3
With ActiveChart
.HasTitle = False
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With
'create image file, delete data, delete chart
Fname = ThisWorkbook.Path & "\" & "ChartF(x).gif"
ActiveChart.Export Filename:=Fname, FilterName:="GIF"
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete
'load chart image to image control on sheet1
Sheets("Sheet2").Select
Sheets("Sheet2").Image1.Picture = _
LoadPicture(ThisWorkbook.Path & "\" & "ChartF(x).gif")
'Fname.Path 'kill filepath
Application.ScreenUpdating = True
With Sheets("Sheet2")
Set ObjTargetRange = .Range(.Cells(1, 1), .Cells(30, "E"))
End With
End SubPlace the following code in the userform code..
Code:
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
'\\ 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
Const CF_BITMAP = 2
Const CF_PALETTE = 9
Const IMAGE_BITMAP = 0
Const LR_COPYRETURNORG = &H4
Const PICTYPE_BITMAP = 1
Private Sub CommandButton1_Click()
Call ChartFunction
Call MakeScreenShot
End Sub
Private Sub UserForm_Activate()
Call MakeScreenShot
End Sub
Sub MakeScreenShot()
Dim IID_IDispatch As GUID
Dim uPicinfo As uPicDesc
Dim IPic As IPicture
Dim hPtr As Long
Dim strPictureFile As String
On Error GoTo ErFix
'\\ Define the image file Fullname
strPictureFile = Environ("TEMP") & "\ImageFilename"
'\\ Copy Range to ClipBoard
ObjTargetRange.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
OpenClipboard 0
hPtr = GetClipboardData(CF_BITMAP)
CloseClipboard
'\\ Create the interface GUID for the picture
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 = PICTYPE_BITMAP '\\ Type of Picture
.hPic = hPtr '\\ Handle to image.
.hPal = 0 '\\ Handle to palette (if bitmap).
End With
'\\ Create the Range Picture Object
OleCreatePictureIndirect uPicinfo, IID_IDispatch, True, IPic
'\\ Save Picture Object and Load it on the Frame
stdole.SavePicture IPic, strPictureFile
With Frame1
'\\ Format the Frame control so it dynamically adapts to the size of the selected range
.Picture = LoadPicture(strPictureFile)
.BorderStyle = fmBorderStyleNone
.Caption = ""
If .InsideWidth < ObjTargetRange.Width Or .InsideHeight < ObjTargetRange.Height Then
.ScrollBars = fmScrollBarsBoth
.KeepScrollBarsVisible = fmScrollBarsBoth
.ScrollWidth = ObjTargetRange.Width
.ScrollHeight = ObjTargetRange.Height
End If
End With
' \\ We don't need the save picture anymore
Kill strPictureFile
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "Error # 16. Quit this session. Do NOT save changes"
End SubTo start use ...
Code:
Private Sub CommandButton1_Click()
With Sheets("Sheet2")
Set ObjTargetRange = .Range(.Cells(1, 1), .Cells(30, "E"))
End With
UserForm1.Show
End SubTesting will show that the frame displays updated data but the chart shown is always the previous chart ie. the current chart is displayed in the image control but not in the frame control. I don't get it? I sure would like to if anyone has any suggestions. Dave
ps. It is Jaafar's code that I "borrowed" for the screen shot part
