Excel 2007/Vista - PastePicture Problem

[Nick H]

Has anyone found a way to get Stephen Bullens PastePicture code...
http://www.oaltd.co.uk/Excel/Default.htm
....to work in Excel 2007?

It does an excellent job for me in an app that I developed in Excel
2003 but falls over in 2007. Or is it perhaps the fault of the Vista
user32.dll?

I have two machines, one running Office 2003 on XP the other running
Office 2007 on Vista. On the Vista machine when the
IsClipBoardAvailable function is passed an xlBitmap type it returns 0.
As a result PastePicture returns nothing. I can get it to work if I
pass the the argument as xlPicture and save it as a .emf but I need
a .bmp because I then want to load the picture into a control.

The problem can be demonstrated by running Stephen's PastePicture.xls
example workbook. On my Vista/Excel 2007 machine the chart picture
only displays if the picture type is set to Metafile on the demo form.

Br, Nick

 

[Peter T]

It's not related to Vista but it seems in Excel 2007 with CopyPicture,
whether the format set to Bitmap or Metafile, only a metafile gets copied to
the clipboard, not useful at all.

In a quick test a workaround that seems to work is simply copy, literally
"copy", eg

ActiveChart.Chartarea.Copy
or
ActiveSheet.ChartObjects(1).Chart.ChartArea.Copy

If you do that both formats will be copied to the clipboard, then take your
pick.

Regards,
Peter T

 

[Nick H]

Peter you star, Thank you!

As it happens I'd adapted Stephen's code to copy a number of
individual cells (simple coloured squares), rather than a chart. I
then use the small coloured bitmaps against a custom Status menu's
controls - a sort of traffic light system.

Using the insight you gave me I created coloured 'shapes' to copy, as
an alternative to the coloured cells and used 'Copy' rather than
'CopyPicture'. Curiously the straight forward Copy method doesn't work
in Excel 2003 so, for dual compatibility, my code to call the
PastePicture function now looks like this...
(Beware of wrap-around)

Public Sub CreateStatusKeyBitmaps()
Dim i As Long
Dim oPic As IPictureDisp

For i = 0 To 5
If Application.Version < 12 Then
'Excel 2003 code
If wksParams.Range("Status" & i).CopyPicture(xlScreen,
xlBitmap) Then
Set oPic = PastePicture(xlBitmap)
SavePicture oPic, Environ("TEMP") & "\Status" & i &
".bmp"
End If
Else
'Excel 2007 code
wksParams.Shapes("Rectangle " & i).Copy
Set oPic = PastePicture(xlBitmap)
SavePicture oPic, Environ("TEMP") & "\Status" & i & ".bmp"
End If
Next i

End Sub

....Elsewhere, triggered by a Worksheet_Activate() event, another
routine loads these saved bitmaps against the afore-mentioned menu
items as the menu is created on the fly for certain sheets. The menu
is deleted by the Worksheet_Deactivate() or Workbook_WindowDeactivate
() events so that it doesn't appear in the wrong context.

I hope someone else finds this useful. Not much consolation here for
those that need to create a bitmap from a range I'm afraid.

Br, Nick H

 

[Peter T]

Thanks for the feedback

I've had a more detailed look but don't think you need to start using shapes
instead of cells. Maybe you could confirm or otherwise you get the same
results in 2003/2007 (see debug results below)

Private Declare Function IsClipboardFormatAvailable Lib "user32" ( _
ByVal wFormat As Integer) As Long

Const CF_BITMAP = 2
Const CF_ENHMETAFILE = 14

Sub test()

Application.CutCopyMode = False
Debug.Print "Bitmap", "Metafile", Application.Version

With Range("A14")
.CopyPicture xlScreen, xlBitmap
QClipboard "Range CopyPicture ,, xlBitmap"
.CopyPicture xlScreen, xlPicture
QClipboard "Range.CopyPicture ,, xlPicture"
.Copy
QClipboard "Range.Copy"
End With
Debug.Print
With ActiveSheet.Rectangles(1)
.CopyPicture xlScreen, xlBitmap
QClipboard "Shape CopyPicture ,, xlBitmap"
.CopyPicture xlScreen, xlPicture
QClipboard "Shape.CopyPicture ,, xlPicture"
.Copy
QClipboard "Shape.Copy"
End With
Debug.Print
With ActiveSheet.ChartObjects(1).Chart
.CopyPicture xlScreen, xlBitmap
QClipboard "Chart.CopyPicture ,, xlBitmap"
.CopyPicture xlScreen, xlPicture
QClipboard "Chart.CopyPicture ,, xlPicture"
.ChartArea.Copy
QClipboard "ChartArea.Copy"
End With

End Sub


Sub QClipboard(s As String)
Dim bBMP As Boolean, bEMF As Boolean

bBMP = IsClipboardFormatAvailable(CF_BITMAP)
bEMF = IsClipboardFormatAvailable(CF_ENHMETAFILE)

Debug.Print bBMP, bEMF, s

Application.CutCopyMode = False

End Sub

Excel 2000/2003
Bitmap Metafile 11.0
True False Range CopyPicture ,, xlBitmap
False True Range.CopyPicture ,, xlPicture
True True Range.Copy

True False Shape CopyPicture ,, xlBitmap
False True Shape.CopyPicture ,, xlPicture
False True Shape.Copy

True False Chart.CopyPicture ,, xlBitmap
False True Chart.CopyPicture ,, xlPicture
False True ChartArea.Copy


Excel 2007
Bitmap Metafile 12.0
False True Range CopyPicture ,, xlBitmap ***
False True Range.CopyPicture ,, xlPicture
True True Range.Copy

True False Shape CopyPicture ,, xlBitmap
False True Shape.CopyPicture ,, xlPicture
True True Shape.Copy

False True Chart.CopyPicture ,, xlBitmap ***
False True Chart.CopyPicture ,, xlPicture
True True ChartArea.Copy


In Excel 2007 CopyPicture with Bitmap format does not work with correctly
with Range and Chart, but does work correctly with Shapes, see stared
results

I got similar results with Appearance:=xlScreen & xlPrinter
EXCEPT in 2007 Shape-object.CopyPicture(xlPrinter, xlBitmap) errors

Regards,
Peter T

 

[Peter T]

PS,

Add a Rectangle and an embedded Chart to the activesheet before testing

Peter T

 

[Nick H]

Nice one Peter.

Yes I can confirm that my results are the same as yours. Which means I
can simply my code to the following and it works in both versions of
Excel...
(again beware of wrap-around)

Public Sub CreateStatusKeyBitmaps()
Dim i As Long
Dim oPic As IPictureDisp

For i = 0 To 5
wksParams.Range("Status" & i).Copy
Set oPic = PastePicture(xlBitmap)
SavePicture oPic, Environ("TEMP") & "\Status" & i & ".bmp"
Next i
End Sub


....however I won't be doing that. To muddy the waters still further,
here's why...

When I drew my coloured rectangle shapes I added a gradient fill which
gave them a cool 3D look that made a marked improvement to the look of
the menu items in XL2007. Incidentally I placed them precisely over
the original ranges that I'd been copying, in the hope that the 2003
'Range.CopyPicture' would see them - and it does!

Cue the new 'Range.Copy' code and that sees the natty new shapes too -
but only in XL2003. ?:^(

Using 'Range.Copy' in XL2007 gives the plain old flat colour of the
range beneath.

None-the-less, I am pleased with the current results from my 'dual-
version' code so thank you very much for your help Peter and I hope
others benefit too.

Br, Nick H