Tenho um código que salva um range de células como imagem .bmp. Ele funcionava no office 2007 com windows xp; mas não funciona no office 2011 com win 7 64 bits. Pedi para um amigo testar e ele concluiu que o problema não é sistema operacional, mas sim a versao do office. Mesmo botando PtrSafe, não funciona... Segue o código. Testo com: SaveRangePic Range("B2:D30"), "C:\teste.bmp" Option Explicit Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long Private Declare PtrSafe Function OleCreatePictureIndirect Lib "olepro32.dll" _ (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, _ IPic As IPicture) As Long '\\ Declare a UDT to store a GUID for the IPicture OLE Interface Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type '\\ Declare a UDT to store the bitmap information Private Type uPicDesc Size As Long Type As Long hPic As Long hPal As Long End Type Private Const CF_BITMAP = 2 Private Const PICTYPE_BITMAP = 1 Sub SaveRangePic(SourceRange As Range, FilePathName As String) Dim IID_IDispatch As GUID Dim uPicinfo As uPicDesc Dim IPic As IPicture Dim hPtr As Long '\\ Copy Range to ClipBoard SourceRange.CopyPicture Appearance:=xlScreen, Format:=xlBitmap OpenClipboard 0 hPtr = GetClipboardData(CF_BITMAP) CloseClipboard '\\ Create the interface GUID for the picture With IID_IDispatch .Data1 = &H7BF80980 .Data2 = &HBF32 .Data3 = &H101A .Data4(0) = &H8B .Data4(1) = &HBB .Data4(2) = &H0 .Data4(3) = &HAA .Data4(4) = &H0 .Data4(5) = &H30 .Data4(6) = &HC .Data4(7) = &HAB End With '\\ Fill uPicInfo with necessary parts. With uPicinfo .Size = Len(uPicinfo) '\\ Length of structure. .Type = PICTYPE_BITMAP '\\ Type of Picture .hPic = hPtr '\\ Handle to image. .hPal = 0 '\\ Handle to palette (if bitmap). End With '\\ Create the Range Picture Object OleCreatePictureIndirect uPicinfo, IID_IDispatch, True, IPic '\\ Save Picture Object stdole.SavePicture IPic, FilePathName End Sub
