ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Out of Memory Error in Excel 2007 but OK in 2003 - Please help. (https://www.excelbanter.com/excel-programming/428655-out-memory-error-excel-2007-but-ok-2003-please-help.html)

[email protected]

Out of Memory Error in Excel 2007 but OK in 2003 - Please help.
 
Hi,

I am trying to execute a code which should save a range of cells as
image.

Here is the code:

Option Explicit

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

Private Const CF_BITMAP = 2
Private Const PICTYPE_BITMAP = 1

Private Function SaveRangePic(SourceRange As Range, FilePathName As
String)


Dim IID_IDispatch As GUID
Dim uPicinfo As uPicDesc
Dim IPic As IPicture
Dim hPtr As Long

'\\ Copy Range to ClipBoard
SourceRange.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
stdole.SavePicture IPic, FilePathName <<<<<<< FAILS HERE IN 2007

End Function

When I am using Excel 2003, the code works fine. But if I use Excel
2007, I get "Out of Memory" error in the last line of the code which I
have marked.

What could be the reason? or do I need to modify the lines? Help me
out.

Thanks


All times are GMT +1. The time now is 12:54 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com