View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Peter T Peter T is offline
external usenet poster
 
Posts: 5,600
Default 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