Skip to: Site menu | Main content

Login

Name: 
Password:
Remember me?
Register

Saving a Spreadsheet Range as a .bmp image file

written by Mark Rowlinson - Last updated Mar 2006

The following code will save a spreadsheet range as a bitmap:

Option Explicit 
 
Private Type PicBmp 
    Size As Long 
    Type As Long 
        hBmp As Long 
        hPal As Long 
        Reserved As Long 
    End Type 
     
    Private Type Guid 
        Data1 As Long 
        Data2 As Integer 
        Data3 As Integer 
        Data4(0 To 7) As Byte 
    End Type 
     
    Private Const CF_BITMAP = 2 
    Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _ 
    (PicDesc As PicBmp, RefIID As Guid, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long 
    Private Declare Function GetClipboardData Lib "user32"  _ 
    (ByVal wFormat As Long) As Long 
    Private Declare Function CloseClipboard Lib "user32" () As Long 
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long 
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ 
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 
     
    Sub SaveImage(rng As Range, strFileName As String) 
        Dim hwnd As Long 
        Dim hPtr As Long 
        hwnd = FindWindow("xlmain", Application.Caption) 
        rng.CopyPicture xlScreen, xlBitmap 
        OpenClipboard hwnd 
        hPtr = GetClipboardData(CF_BITMAP) 
        SavePicture CreateBitmapPicture(hPtr), strFileName 
        CloseClipboard 
    End Sub 
     
     
    Function CreateBitmapPicture(ByVal hBmp As Long) As IPicture 
        Dim lngR As Long, Pic As PicBmp, IPic As IPicture, IID_IDispatch As Guid 
         
        With IID_IDispatch 
            .Data1 = &H20400 
            .Data4(0) = &HC0 
            .Data4(7) = &H46 
        End With 
         
        With Pic 
            .Size = Len(Pic) 
            .Type = 1 
            .hBmp = hBmp 
        End With 
         
        lngR = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic) 
        Set CreateBitmapPicture = IPic 
    End Function

To use it pass the range you want to display and a filename to use e.g.

SaveImage Sheet1.Range("A1:A8"), "C:Documents and settingsmarkdesktoptest.bmp"

Incidentally if you used VB6 and compiled to a COM addin you would only need:

SavePicture Clipboard.GetData(vbCFBitmap), "C:Documents and settingsmarkdesktoptest2.bmp"

To do the picture saving bit!