Copy Picture generates Insufficient Resources error

[nicnad]

Hi,

I have the following code to export a range as a picture. The original code from is from here (http://www.mvps.org/dmcritchie/excel/xl2gif.htm).

'The subroutine To invoke Is GIF_Snapshot To convert a range of cells To a .GIF file.


Option Explicit
'Harold Staff -- see http://www.mvps.org/dmcritchie/excel/xl2gif.htm
'XL2GIF_module -- GIF_Snapshot
Dim container As Chart
Dim containerbok As Workbook
Dim Obnavn As String
Dim Sourcebok As Workbook

Function sShortname(ByVal Orrginal As String) As String
Dim iii As Integer
sShortname = ""
For iii = 1 To Len(Orrginal)
If Mid(Orrginal, iii, 1) <> " " Then _
sShortname = sShortname & Mid(Orrginal, iii, 1)
Next
End Function

Private Sub ImageContainer_init()
Workbooks.Add (1)
ActiveSheet.Name = "GIFcontainer"
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData source:=Worksheets(1).Range("A1")
ActiveChart.Location Where:=xlLocationAsObject, _
Name:="GIFcontainer"
ActiveChart.ChartArea.ClearContents
Set containerbok = ActiveWorkbook
Set container = ActiveChart
End Sub

Sub MakeAndSizeChart(ih As Integer, iv As Integer)
Dim Hincrease As Single
Dim Vincrease As Single
Obnavn = Mid(ActiveChart.Name, Len(ActiveSheet.Name) + 1)
Hincrease = ih / ActiveChart.ChartArea.Height
ActiveSheet.Shapes(Obnavn).ScaleHeight Hincrease, _
msoFalse, msoScaleFromTopLeft
Vincrease = iv / ActiveChart.ChartArea.Width
ActiveSheet.Shapes(Obnavn).ScaleWidth Vincrease, _
msoFalse, msoScaleFromTopLeft
End Sub

Public Sub GIF_Snapshot()
Dim varReturn As Variant
Dim MyAddress As String
Dim SaveName As Variant
Dim MySuggest As String
Dim Hi As Integer
Dim Wi As Integer
Dim Suffiks As Long

Application.CutCopyMode = False


Set Sourcebok = ActiveWorkbook
MySuggest = sShortname(ActiveSheet.Name)
ImageContainer_init
Sourcebok.Activate
MyAddress = ThisWorkbook.ActiveSheet.PivotTables(1).TableRange1.Address
If MyAddress <> "A1" Then
SaveName = Application.GetSaveAsFilename( _
InitialFileName:=MySuggest _
& ".gif", fileFilter:="Gif Files (*.gif), *.gif")
Range(MyAddress).Select
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlBitmap
If SaveName = False Then
GoTo Avbryt
End If
If InStr(SaveName, ".") Then SaveName _
= Left(SaveName, InStr(SaveName, ".") - 1)
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlBitmap
Hi = Selection.Height + 4 'adjustment for gridlines
Wi = Selection.Width + 6 'adjustment for gridlines
containerbok.Activate
ActiveSheet.ChartObjects(1).Activate
MakeAndSizeChart ih:=Hi, iv:=Wi
ActiveChart.Paste
ActiveChart.Export Filename:=LCase(SaveName) & _
".gif", FilterName:="GIF"
ActiveChart.Pictures(1).delete
Sourcebok.Activate
End If
Avbryt:
On Error Resume Next
Application.StatusBar = False
containerbok.Saved = True
containerbok.Close
End Sub


When I run GIF_snapshot I get the insufficient resources error. The debuger stop on the following line : Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlBitmap


What is the proper way to export a big pivot table ( my actual pivot table range is a1:e450) as a picture?

Thank you for your help!

[Kenneth Hobs]

After MyAddress, do:
Debug.print MyAddressThen look at the Immediate window when you run it to see what address is being set.

[Paul_Hossler]

The link also has a comment ...




Limitations are the size of a bitmap image copied in Excel, I guess it's a graphics limitation like "maximum possible screen resolution" or something like that.


and your PT range (a1:e450) is probably bumping against the limit


I'd think that a 5 x 450 grid would be awfully big as a picture, and wouldn't fit onto a page or screen?

Does it really have to be that large?

Paul