vba code to export image file, preferably jpg

daveus

Board Regular
Joined
May 18, 2004
Messages
191
Hi all,

I searched and didn't find anything related to this.

I would like vba code that will export a given group of cells, or a defined print page area to a jpg file (preferable, but other image format would work). I'm planning to create a program that will change some cell data and create a jpg file for various sets of data. I suppose if that's not possible that another alternative would be ok, so i'm open to suggestions, but the export to jpg format would be great. I found a little program that will do it, but i wanted to include the code in my program to make it all automated.

Any help is greatly appreciated. Thanks all!

David
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Hi,

The following SaveRangePic custom function will save a range as bmp file.

Code:
Option Explicit

Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long

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

Private Declare Function CloseClipboard Lib "user32" () As Long

Private Declare 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

Private 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


Here is a test routine that will save a picture of range A1:A20 of sheet1 in the C directory :

Code:
Sub Test()

    SaveRangePic Sheet1.Range("A1:A20"), "C:\MyRangePic.bmp"

End Sub

Regards.
 
Upvote 0
Hi,

Try Andy's Add-In

Or a non-vba method is select/highlight the range > hold down Shift key > go to Edit > Copy Picture > open paint > paste and save as jpeg file.

HTH
 
Upvote 0
Thanks for all the comments!

rafaaj2000, can this code be edited to export jpg? If not, this should work, but i just wanted to ask.

Thanks again everyone. Anyone elses solutions are still welcome.

David
 
Upvote 0
Thanks again everyone. Anyone elses solutions are still welcome.
did you check the link Kris posted ?


store add-in on your machine
open menu Tools/add-ins
browse to the add-in
...

you will find access to the add-in by menu tools at the bottom

it's great !

kind regards,
Erik
 
Upvote 0
Thanks for all the comments!

rafaaj2000, can this code be edited to export jpg? If not, this should work, but i just wanted to ask.

Thanks again everyone. Anyone elses solutions are still welcome.

David

AFAIK, the SavePicture Method will always save as BMP. I don't know how to save the pic as a JPG .

Regards.
 
Upvote 0
... can this code be edited to export jpg?
In general JPG is an inferior format for exporting pictures of anything in Excel. JPG was designed for compression of images with continuously variable coloring and shading, such as photographs. Formats like GIF and PNG are much better for computer graphics, which may have large regions with a constant color, and sharp transitions between regions. Look at the text in a JPG image, and you should see the deficiency in JPG for this usage. Web browsers support GIF and PNG.
 
Upvote 0
This post was a while ago.

Any way to save the file in the code rafaaj2000 posted as a gif with a clear background or a white background? any input would be appreciated. thanks all!
 
Upvote 0
Hello daveus, you're better off starting your own thread instead of hijacking this one, and putting a link to this thread in your post. :)
 
Upvote 0

Forum statistics

Threads
1,214,983
Messages
6,122,582
Members
449,089
Latest member
Motoracer88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top