Excel 2007/Vista - PastePicture Problem
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("A1:D4")
.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
"Nick H" wrote in message
...
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
|