Copy range as jpg without creating/deleting chart?

[Joseph Lo]

Hi guys,

I have adapted this code to my spreadsheet.

Private Sub CommandButton1_Click()


    Dim rgExp As Range: Set rgExp = Range("D6:Q27")
    ''' Copy range as picture onto Clipboard
    
    rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    ''' Create an empty chart with exact size of range copied
    
    With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
    Width:=rgExp.Width, Height:=rgExp.Height)
    .Name = "Table"
    .Activate
    End With
    
    ''' Paste into chart area, export to file, delete chart.
    Application.EnableEvents = False
    ActiveChart.Paste
    ActiveSheet.ChartObjects("Table").Chart.Export Filename:=Application.ActiveWorkbook.Path & "\T25(1).jpg", Filtername:="jpg"
    ActiveSheet.ChartObjects("Table").Delete
    Application.EnableEvents = True


End Sub

It works fine but only when the worksheet and workbook is not password protected. When the worksheet/workbook is protected, the sub-routine will fail.

So my question is: Is there any way I can export a saved range to a jpg via another method?

Thanks

 

[RoryA]

Weird. I'll try and set up a VM to test XP and different office versions. I did alter the original wFormat argument from Integer to Long but I don't really see that being a problem here.

 

[Joseph Lo]

I would like to test the save to disk method with this code as I think this capability will come in handy one day....but from inspecting the code, I don't see the stdole.savepicture method.

Could you please tell me where is this section of the code?

Thanks

 

[RoryA]

It's not there, since it's a separate library. You would just use:

    Range("A1:E100").CopyPicture xlScreen, xlBitmap
Savepicture pastepicture(xlBitmap), "C:\some path\myPic.bmp"

for example.

 

[Joseph Lo]

Thanks Rory. I have just tested this on my box and it is working fine too. Have not tested this on a Win7 box or a 32 bit system however.

 

[Jaafar Tribak]

After inspection of the code I found that when copying a range as xlBitmap, the IsClipboardFormatAvailable function returns 0 which means that the CF_BITMAP data format is not available in the clipboard ... Do not know if this happens specifically in office 2007

Copying the range as xlPicture seems to solve the problem because it puts the range image in the clipboard in CF_ENHMETAFILE format

The following now works without errors for copying everything (worksheet ranges as well as shapes)

Sub Test()
   [COLOR=#008000] 'Sheet1.Shapes(1).CopyPicture xlScreen, xlPicture[/COLOR]
    Sheet1.Range("a1:a10").CopyPicture xlScreen, xlPicture
    SavePicture PastePicture(xlPicture), "C:\myPic.bmp"
End Sub

 

[NdNoviceHlp]

Here's an interesting link on the topic that may shed some light on why the .Copy for ranges to pictures is useful and how copypicture is different for different office versions. There's also quite a bit of stuff on the web about how the clipboard will randomly fail on repeated useage of picture copying hence the posted emptyclipboard code. HTH. Dave
Re: Excel 2007/Vista - PastePicture Problem

 

[pgc01]

Hi

I've been following this thread and it's interesting to have a code to copy the picture that is almost independent from excel.

In this case, however, with just a little tweak Joseph's code would work.

I don't know if it would not be better to use it, as it's a simple vba code, easy to understand.

I just tested the modification in post #7 and it seems to work ok (for the real case amend the range and the file pathname):

Private Sub CommandButton1_Click()
Dim chtO As ChartObject
Dim r As Range

    Set r = Range("A1:C3")
    
    ''' Copy range as picture onto Clipboard
    r.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    
    ''' Add a workbook, paste the picture into an empty chart, export it and close the workbook
    With Workbooks.Add
        Set chtO = .Worksheets(1).ChartObjects.Add(Left:=r.Left, Top:=r.Top, Width:=r.Width, Height:=r.Height)
        With chtO.Chart
            .Paste
            .Export Filename:="c:\tmp\chtCopy.jpg", Filtername:="jpg"
        End With
        .Close SaveChanges:=False
    End With
End Sub

 

[NdNoviceHlp]

The trouble is that you can't clear the clipboard of the picture(s) and if you repetitively call the routine, XL randomly crashes with some clipboard error message. The API thing avoids this. Rather than add then delete a wb, here's some code to add a chart to the active wb, make a pic file of the range, then delete the chart as if nothing happenned. But it doesn't clear the clipboard which I assume will randomly falter with repetitive use. I'm guessing that the copypicture part also needs to be adjusted to accomodate all MS versions. I agree, much simpler but I could never resolve the random crash thing. Dave

 Private Sub CommandButton1_Click()
Dim chtO As ChartObject
Dim r As Range
'Rng that will be picture
Set r = Sheets("Sheet1").Range("A1:C3")
'Copy range as picture onto Clipboard
r.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
'set sheet to blank ws to add chart
Set chtO = Sheets("Sheet2").ChartObjects.Add(Left:=r.Left, Top:=r.Top, Width:=r.Width, Height:=r.Height)
'set file path for picture
With chtO.Chart
    .Paste
    .Export Filename:="c:\test\chtCopy.jpg", Filtername:="jpg"
    .ChartArea.Select
End With
'remove chart
ActiveWindow.Visible = False
ActiveChart.Parent.Delete
'how to clear clipboard????
Application.CutCopyMode = False 'doesn't work!!!
End Sub

 

[Jaafar Tribak]

The trouble is that you can't clear the clipboard of the picture(s) and if you repetitively call the routine, XL randomly crashes with some clipboard error message. The API thing avoids this. Rather than add then delete a wb, here's some code to add a chart to the active wb, make a pic file of the range, then delete the chart as if nothing happenned. But it doesn't clear the clipboard which I assume will randomly falter with repetitive use. I'm guessing that the copypicture part also needs to be adjusted to accomodate all MS versions. I agree, much simpler but I could never resolve the random crash thing. Dave

To empty the windows clipboard use the following API functions as follows :

Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long

Sub test()
    OpenClipboard 0&
    EmptyClipboard
    CloseClipboard
End Sub

As for using the chart export method to copy the range picture I guess it will be much cleanear to do it in a blank workbook in a seperate invisible Excel instance

 

[pgc01]

Sorry, I was out last week

The trouble is that you can't clear the clipboard of the picture(s) and if you repetitively call the routine, XL randomly crashes with some clipboard error message.

NdNoviceHlp, thank you. I was not aware of that instability problem. The clipboard must be dealt with.

As for using the chart export method to copy the range picture I guess it will be much cleanear to do it in a blank workbook in a seperate invisible Excel instance

Thank you Jaafar, I agree, it does feel cleaner.