none
[Excel] How to convert Excel to jpg, gif image?

    Question

  • How to convert MS Excel to jpg or gif and paste/insert to MS Word? thank you very much

     

     

    Tuesday, August 08, 2006 2:33 AM

Answers

  • I had found the solution from web site PastePicture.zip that API method able to save target range image to the Clip board and save it to BMP format. It is capable to support unreadable cells export to picture.



    '***************************************************************************
    '*
    '* MODULE NAME:     Paste Picture
    '* AUTHOR & DATE:   STEPHEN BULLEN, Office Automation Ltd
    '*                  15 November 1998
    '*
    '* CONTACT:         Stephen@oaltd.co.uk
    '* WEB SITE:        http://www.oaltd.co.uk
    '*
    '* DESCRIPTION:     Creates a standard Picture object from whatever is on the clipboard.
    '*                  This object can then be assigned to (for example) and Image control
    '*                  on a userform.  The PastePicture function takes an optional argument of
    '*                  the picture type - xlBitmap or xlPicture.
    '*
    '*                  The code requires a reference to the "OLE Automation" type library
    '*
    '*                  The code in this module has been derived from a number of sources
    '*                  discovered on MSDN.
    '*
    '*                  To use it, just copy this module into your project, then you can use:
    '*                      Set Image1.Picture = PastePicture(xlPicture)
    '*                  to paste a picture of whatever is on the clipboard into a standard image control.
    '*
    '* PROCEDURES:
    '*   PastePicture   The entry point for the routine
    '*   CreatePicture  Private function to convert a bitmap or metafile handle to an OLE reference
    '*   fnOLEError     Get the error text for an OLE error code
    '***************************************************************************

    Option Explicit
    Option Compare Text

    ''' User-Defined Types for API Calls

    '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

    '''Windows API Function Declarations

    'Does the clipboard contain a bitmap/metafile?
    Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long

    'Open the clipboard to read
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long

    'Get a pointer to the bitmap/metafile
    Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long

    'Close the clipboard
    Private Declare Function CloseClipboard Lib "user32" () As Long

    'Convert the handle into an OLE IPicture interface.
    Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long

    'Create our own copy of the metafile, so it doesn't get wiped out by subsequent clipboard updates.
    Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long

    'Create our own copy of the bitmap, so it doesn't get wiped out by subsequent clipboard updates.
    Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long

    'The API format types we're interested in
    Const CF_BITMAP = 2
    Const CF_PALETTE = 9
    Const CF_ENHMETAFILE = 14
    Const IMAGE_BITMAP = 0
    Const LR_COPYRETURNORG = &H4

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''' Subroutine: PastePicture
    '''
    ''' Purpose:    Get a Picture object showing whatever's on the clipboard.
    '''
    ''' Arguments:  lXlPicType - The type of picture to create.  Can be one of:
    '''                          xlPicture to create a metafile (default)
    '''                          xlBitmap to create a bitmap
    '''
    ''' Date        Developer           Action
    ''' --------------------------------------------------------------------------
    ''' 30 Oct 98   Stephen Bullen      Created
    ''' 15 Nov 98   Stephen Bullen      Updated to create our own copies of the clipboard images
    '''

    Function PastePicture(Optional lXlPicType As Long = xlPicture) As IPicture

    'Some pointers
    Dim h As Long, hPicAvail As Long, hPtr As Long, hPal As Long, lPicType As Long, hCopy As Long

    'Convert the type of picture requested from the xl constant to the API constant
    lPicType = IIf(lXlPicType = xlBitmap, CF_BITMAP, CF_ENHMETAFILE)

    'Check if the clipboard contains the required format
    hPicAvail = IsClipboardFormatAvailable(lPicType)

    If hPicAvail <> 0 Then
        'Get access to the clipboard
        h = OpenClipboard(0&)

        If h > 0 Then
            'Get a handle to the image data
            hPtr = GetClipboardData(lPicType)

            'Create our own copy of the image on the clipboard, in the appropriate format.
            If lPicType = CF_BITMAP Then
                hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
            Else
                hCopy = CopyEnhMetaFile(hPtr, vbNullString)
            End If

            'Release the clipboard to other programs
            h = CloseClipboard

            'If we got a handle to the image, convert it into a Picture object and return it
            If hPtr <> 0 Then Set PastePicture = CreatePicture(hCopy, 0, lPicType)
        End If
    End If

    End Function


    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''' Subroutine: CreatePicture
    '''
    ''' Purpose:    Converts a image (and palette) handle into a Picture object.
    '''
    '''             Requires a reference to the "OLE Automation" type library
    '''
    ''' Arguments:  None
    '''
    ''' Date        Developer           Action
    ''' --------------------------------------------------------------------------
    ''' 30 Oct 98  Stephen Bullen      Created
    '''

    Private Function CreatePicture(ByVal hPic As Long, ByVal hPal As Long, ByVal lPicType) As IPicture

    ' IPicture requires a reference to "OLE Automation"
    Dim r As Long, uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPicture

    'OLE Picture types
    Const PICTYPE_BITMAP = 1
    Const PICTYPE_ENHMETAFILE = 4

    ' Create the Interface GUID (for the IPicture interface)
    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 = IIf(lPicType = CF_BITMAP, PICTYPE_BITMAP, PICTYPE_ENHMETAFILE)  ' Type of Picture
        .hPic = hPic                                                            ' Handle to image.
        .hPal = IIf(lPicType = CF_BITMAP, hPal, 0)                              ' Handle to palette (if bitmap).
    End With

    ' Create the Picture object.
    r = OleCreatePictureIndirect(uPicInfo, IID_IDispatch, True, IPic)

    ' If an error occured, show the description
    If r <> 0 Then Debug.Print "Create Picture: " & fnOLEError(r)

    ' Return the new Picture object.
    Set CreatePicture = IPic

    End Function

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''' Subroutine: fnOLEError
    '''
    ''' Purpose:    Gets the message text for standard OLE errors
    '''
    ''' Arguments:  None
    '''
    ''' Date        Developer           Action
    ''' --------------------------------------------------------------------------
    ''' 30 Oct 98   Stephen Bullen      Created
    '''

    Private Function fnOLEError(lErrNum As Long) As String

    'OLECreatePictureIndirect return values
    Const E_ABORT = &H80004004
    Const E_ACCESSDENIED = &H80070005
    Const E_FAIL = &H80004005
    Const E_HANDLE = &H80070006
    Const E_INVALIDARG = &H80070057
    Const E_NOINTERFACE = &H80004002
    Const E_NOTIMPL = &H80004001
    Const E_OUTOFMEMORY = &H8007000E
    Const E_POINTER = &H80004003
    Const E_UNEXPECTED = &H8000FFFF
    Const S_OK = &H0

    Select Case lErrNum
    Case E_ABORT
        fnOLEError = " Aborted"
    Case E_ACCESSDENIED
        fnOLEError = " Access Denied"
    Case E_FAIL
        fnOLEError = " General Failure"
    Case E_HANDLE
        fnOLEError = " Bad/Missing Handle"
    Case E_INVALIDARG
        fnOLEError = " Invalid Argument"
    Case E_NOINTERFACE
        fnOLEError = " No Interface"
    Case E_NOTIMPL
        fnOLEError = " Not Implemented"
    Case E_OUTOFMEMORY
        fnOLEError = " Out of Memory"
    Case E_POINTER
        fnOLEError = " Invalid Pointer"
    Case E_UNEXPECTED
        fnOLEError = " Unknown Error"
    Case S_OK
        fnOLEError = " Success!"
    End Select

    End Function









    --Paste below coding to new module--

    Declare Function SystemParametersInfo Lib "user32" _
       Alias "SystemParametersInfoA" (ByVal uAction As Long, _
       ByVal uParam As Long, ByVal lpvParam As Any, _
       ByVal fuWinIni As Long) As Long
     
    Public Const SPI_SETDESKWALLPAPER = 20
     
    Public Const SPIF_SENDWININICHANGE = &H2
     
    Public Const SPIF_UPDATEINIFILE = &H1
     
    Public Sub SetWallpaper(ByVal FileName As String)
     
      Dim x As Long
     
      x = SystemParametersInfo(SPI_SETDESKWALLPAPER, _
      0&, FileName, SPIF_SENDWININICHANGE Or SPIF_UPDATEINIFILE)
       
    End Sub

    Sub PrintDesktop(ByRef xlrng As Excel.Range, ByVal strFileName As String)
     
        Dim oPic As IPictureDisp
      
        xlrng.CopyPicture xlScreen, xlBitmap
        Set oPic = PastePicture(xlBitmap)
        'Fname = "C:\iFlash.bmp"
        SavePicture oPic, strFileName
       
     
    End Sub


    Thursday, November 29, 2007 3:08 AM

All replies

  • I assume you're talking about simply taking a screenshot of the viewable range of the MS Excel document for insertion into a MS Word document.  Do you need to do this programatically?  If not, just hit PrtScr on your keyboard, paste it into MS Paint, save it, and insert it into the Word document.

    If you need to do this in a program, you've got two obstacles to overcome as I see it:

    1.) VBA doesn't provide a "native" method for taking screenshots (as far as I know).  I believe you'll need to access the API to do this.  If this does turn out to be the case, I can help you out with code.

    2.) VBA has no support for converting bitmap images (which is the format your screenshot would be in) into .JPG or .GIF files.  You'd need to use external libraries.

    If you can provide a bit more information on what you need to do and why, I can give you much more specific advice on how to solve the problem.

    Wednesday, August 09, 2006 3:11 AM
  • I want copy excel selected range convert to jpg, gif and paste to MS outlook mail. Thank you
    Wednesday, August 09, 2006 12:35 PM
  • I doubt very much you can do that, or if you can it's a long difficult way to do a simple thing.

    If your looking to email parts of a spreadsheet your best bet is to format the cells into html/text and display them in the email message. How you go about putting the cells as html/text into an email message is another matter, if you co with copy and paste then the user needs to manually do the paste in Outlook, on the other hand if your sending the email through VBA interop with Outlook objects then all you need to do is create the email and set it's message body and address info.

    Wednesday, August 09, 2006 9:35 PM
  •  Perry Choy wrote:
    I want copy excel selected range convert to jpg, gif and paste to MS outlook mail. Thank you

    I'll repeat my previous question: do you NEED to do this programatically?  Why not just take a screenshot manually, convert it using an imaging program, and paste the resulting JPG/GIF file into the message?

    Thursday, August 10, 2006 2:57 AM
  • Yes, i need to do this programatically. thanks
    Thursday, August 10, 2006 4:43 AM
  • This a very complex problem.  I'd be happy to look at whatever code you might have, but this is far beyond the sort of thing VBA is intended for.

    Friday, August 11, 2006 3:40 AM
  • Sorry, my english es basic  

    XL97: Cómo crear un archivo GIF de un Gráfico de Microsoft Excel

     
    Esto es cuando ya esta creada imagen dentro de la hoja.
     
    Sub creargif()
             Dim mychart As Chart
             Set mychart = ActiveSheet.ChartObjects(1).Chart
             mychart.Export Filename:="c:\Mychart.gif", FilterName:="GIF"
    End Sub
    Sunday, August 13, 2006 6:44 AM
  • If I understand your question, here is how I would go about it:

    1.  Highlight the portion of the Excel sheet you want to copy

    2.  Hold down Shift and click the Edit menu.

    3.  Click Copy Picture (us two defaults selected)

    4.  Paste into Word

    Hope this helps.

     

    Wednesday, August 30, 2006 9:56 PM
  • hi friend

    i have seen in one of the thread , u have suggested using api excel sheet can be converted to jpg gif image.

    could u pls kindly provide me the code

    thanks and regards

    durairaj

     

     

     

    Friday, September 01, 2006 8:06 AM
  • I don't know why everyone thinks it's so hard to copy an image of a region and paste it elsewhere.

    To copy a chart as a picture:

    ActiveChart.CopyPicture _
        Appearance:=xlScreen, Size:=xlScreen, Format:=xlBitmap

    To copy a range as a picture:

    ActiveSheet.Range("B1:C6").CopyPicture Appearance:=xlScreen, Format:=xlBitmap

    These copy the selections as bitmaps, but you can also copy as a metafile (Format:=xlPicture), and you can copy an Excel range and paste it into Word as a table.

    You can get this or similar syntax by simply turning on the macro recorder while you manually do what you want your program to do. Follow up the commands above with pasting of your copied object into the target location or application. I cover similar topics, including the interaction of Excel with other applications, on this web page:

    http://peltiertech.com/Excel/XL_PPT.html

    You can also export an Excel chart as an image file:

    ActiveChart.Export "C:\My Documents\MyChart.gif", "GIF"

    Various image file formats are available, but you would do well to avoid JPG and stick to GIF or PNG.

    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______
    
    Saturday, September 02, 2006 5:23 PM
  •  Jon Peltier wrote:

    I don't know why everyone thinks it's so hard to copy an image of a region and paste it elsewhere.

    I guess I both misunderstood his problem and what the CopyPicture function is capable of.  I was under the impression that he wanted to copy an image of an entire document, rather than just a single region -- simple enough, but I was also working under the misconception that CopyPicture wouldn't be able to grab a screenshot of an area bigger than what could be displayed (don't know why I thought this...)  You're absolutely right!

    Tuesday, September 05, 2006 12:22 PM
  • I had no idea we could copy a range and paste as a graphic...  I do the chart gif thing all the time for userforms (load the .GIF in to an image frame or the background of multipage, etc.).  Copying a range as graphic and saving is as GIF and then using the image would reduce so, so much code writing.  I see many great uses for this!!!

    So --- once we copy the range, can we:

    1)  export as a graphic file and save to the hard drive (like we can with GIF export for the charts)

    2)  control the file fomat (aka - .GIF, .JPEG, etc)

    I did follow the link the gentleman's website and all his code shows pasting the copied range into Excel or other apps.  I didn't see an example where he exported the copied range and saved it as a GIF file.

    I'm going to experiment with a couple ideas and if anything works, I'll post it later.

    Thanks, John.

    Tuesday, September 12, 2006 5:00 AM
  • Not my cleanest code... the only way I can see doing this is by "tricking" Excel into thinking the copied range is a chart.  The attached is a quick & dirty run to see if this would work or not.  It does.  When I use this in a real application I'll create a new workbook, perform the chart, etc., in that work and then delete everything.  The current application I'm working on could use variants of this code 100+ times per session, so I'm very worried about the source workbook(s) becoming corrupted due to the constant adding and deleting of sheets & charts.  We're using Office 2003 here, does XP have an easier way to do this?

    Sub COPY_TEXT_TEST()

        'PROOF OF CONCEPT
        
        Dim FName As String
        Dim Temporary_Worksheet As Worksheet
        Dim Temporary_Chart As Chart
        Dim Temporary_Picture As Picture

        'Adding a temporary worksheet
        Set Temporary_Worksheet = Worksheets.Add

        'Adding a chart, this is just a holding area for the copied range (eventually)
        Charts.Add

        ActiveChart.Location Where:=xlLocationAsObject, Name:=Temporary_Worksheet.Name

        Set Temporary_Chart = ActiveChart

        'Copying my range
        ThisWorkbook.Sheets("BSCs").Range("B7:G21").CopyPicture Appearance:=xlScreen, Format:=xlPicture
       
        'Pasting it on top of chart
        Temporary_Chart.Paste

        Set Temporary_Picture = Selection
        

        'Placing some extra space around the image to keep things clean
        With Temporary_Chart.Parent
            .Width = Temporary_Picture.Width + 5
            .Height = Temporary_Picture.Height + 5
        End With
       
        FName = ThisWorkbook.Path & "\Cache\NEW_PICTURE.gif"
       
        Temporary_Chart.Export Filename:=FName, FilterName:="gif"

    End Sub

     

    Tuesday, September 12, 2006 6:30 AM
  • That seems like a straight-forward way to do it, and it seems like it should work fine.  However, it's going to be awfully inefficient.  Can't you just grab the bitmap data from the clipboard as a DIB and write it to a file, then run external conversion software for the BMP->GIF conversion?  I'll see if I can come up with a way to do this.

    Wednesday, September 13, 2006 1:06 AM
  • hi

    thanks u so much for offering that code, which have drastically reduced manual work.

    once again , thank u so much

     

    Friday, September 15, 2006 8:20 AM
  • thank u so much for offering that code.

    it really worked well.

     

    One more thing to  Ask:

    Could u write me about is there any certification available for VBA , so i could write exam and get one certification for VBA in future.\

    thanks

    stefen

     

     

    Friday, September 15, 2006 8:22 AM
  • Using an external graphics program would not work in a live setting.  Then I'd have to write all the code to make that app do whatever is needed.  And what if the user doesn't have that app?  Ooops...  So then I build into installer, now we need pay license fees for all the possible users how may use the Excel applet.  It may seem inefficient, but in real-time while the userform is running - how else would you do this??? 

     

    I did use the code in an internal applet, but removed it.  It worked fine on my PC, but the results changed depending on the end-user display and the associated dot pitch.  In other words, grabbing a portion of the screen from a 1024x768 is not the same as a 1280x1024 display, not a 1280x1024 display running 1024x768.  There were far too many possible configurations, so the idea didn't work in a applet that would be distributed across multiple users with different PC configurations.

     

    The limited nature of Excel VBA horribly frustrating at times...  We are still importing graphs into forms and have a host if/thens to deal with different screen resolutions.  It's a pain.  A testing is even more of a pain because you need all those bleeping machines to test on...

     

    And to make matters worse, some of the users are Mac's... which is a totally different beast... 

     

    If you need to get the screen resolution, paste this in the top of the module:

    'this is for checking monitor resolution; may not need it since the app is designed for 1024x768.  when added,
    'the monitor check will reside in the auto-open procedure
    Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

    Const SM_CXSCREEN = 0
    Const SM_CYSCREEN = 1

     

    Then in the subsequent procedures you can use code like -

     

       
        ScreenWidth = GetSystemMetrics(SM_CXSCREEN)
        ScreenHeight = GetSystemMetrics(SM_CYSCREEN)
       

    A 1024 x 768 display will return those numbers.  This can be helpful in determining how large a userform should be.  Multiply the resolution by .75 to convert it to the userform size.  In other words 1024 x .75 = Userform.Height. 

    Tuesday, September 26, 2006 6:59 PM
  • Be careful using 0.75 as your conversion. It's probably the most common points to pixels conversion, but it's not the only one.

    For the non-Mac people using your software, you don't need to worry about pixels and resolutions to put a chart onto a userform. Stephen Bullen shows how to put a metafile of a chart onto a userform:

    http://oaltd.co.uk/DLCount/DLCount.asp?file=PastePicture.zip

    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

    Tuesday, September 26, 2006 8:49 PM
  •  duck thing wrote:

    That seems like a straight-forward way to do it, and it seems like it should work fine.  However, it's going to be awfully inefficient.  Can't you just grab the bitmap data from the clipboard as a DIB and write it to a file, then run external conversion software for the BMP->GIF conversion?  I'll see if I can come up with a way to do this.

    Hi duck thing,

    I'd like to know how to grab clipboard data too ;-)

     

    Regards,

    S_DS.

     

    Saturday, January 13, 2007 4:00 PM
  • The link I posted earlier contains code to grab the clipboard data and save it in a number of formats:

    http://oaltd.co.uk/DLCount/DLCount.asp?file=PastePicture.zip

    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

    Saturday, January 13, 2007 4:29 PM
  • Hi all,

    I tried the suggestion of copypicture from an Excel Range and pasting it on a new Chart and then exporting the Chart to a GIF image. My problem is when the range is large (say Column A to Column P and Row 1 to Row 200), the resultant GIF image is unreadable (kinda blurred).

     

    I expected that since the range is large, the resultant image will also be of large dimensions, and the the image will be clear and readable.

     

    Can somebody suggest why did it happen and how can I have large sized picture generated out of the large selected range without getting the image to be blurred?

     

    Thanking you all in advance.

    Monday, July 02, 2007 12:34 PM
  • Was your empty chart large enough for the pasted image, or did the image get shrunk when it was pasted? I just put random numbers into A1: P200, copied the range as a picture, pasted it into an empty chart that covered A1:Q203, and exported the chart as a GIF image file. It was 952x3451 pixels, 245 kb, and crystal clear.

    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Tutorials and Custom Solutions
    Peltier Technical Services, Inc. - http://PeltierTech.com
    _______
    Thursday, July 05, 2007 9:34 PM
  • Hi Jon,

     

    Thanks for the response. My code for doing the job looked like this:

    -----------------------------------------------------------------------------------------------

    oExcel = New Excel.Application

    oBook = oExcel.Workbooks.Open("C:\XYZ.xls")\

    Temporary_Worksheet = oBook.Worksheets.Add

     

    'Adding a chart, this is just a holding area for the copied range (eventually)

    oExcel.Charts.Add()

    oExcel.ActiveChart.Location(Where:=Excel.XlChartLocation.xlLocationAsObject, Name:=Temporary_Worksheet.Name)

    Temporary_Chart = oExcel.ActiveChart

     

    'Copying my range

    oBook.Sheets(strExcelSheetName).Range(strRange).CopyPicture(Appearance:=Excel.XlPictureAppearance.xlScreen, Format:=Excel.XlCopyPictureFormat.xlPicture)

    Try
           'Pasting it on top of chart
           Temporary_Chart.Paste()

    Catch ex As Exception
             If CType(ex, System.Runtime.InteropServices.COMException).ErrorCode = -2146827284 OrElse CType(ex,  System.Runtime.InteropServices.COMException).Message = "Microsoft Office Excel cannot paste the data." Then
            Throw New ApplicationException("Due to the large selected range value, the size of the image exceeds the image size restriction. Please reduce the selected range value and try again.")
            Exit Function
         Else
            Throw ex
         End If

    End Try

     

    Temporary_Picture = oExcel.Selection

     

    'Placing some extra space around the image to keep things clean

    With Temporary_Chart.Parent
         .Width = Temporary_Picture.Width + 5
         .Height = Temporary_Picture.Height + 5

    End With

    Temporary_Chart.Export(Filename:="C:\XYZ.htm", FilterName:="gif")

    oBook.Close()

    oExcel.DisplayAlerts = False

    oExcel.Quit()

    Temporary_Worksheet = Nothing

    Temporary_Chart = Nothing

    Temporary_Picture = Nothing

    -----------------------------------------------------------------------------------------------

    When I changed my above (marked in RED) to following, it solved the problem:

    oBook.Sheets(strExcelSheetName).Range(strRange).CopyPicture(Appearance:=Excel.XlPictureAppearance.xlScreen, Format:=Excel.XlCopyPictureFormat.xlBitmap)

    But, check out the Try Catch block I have used while pasting the copied picture to Chart to Temporary_Chart object. I had to do that, because if the Image Size is greater than about 556 kb, I get the error, Error No: -2146827284, Error Description: Microsoft Office Excel cannot paste the data.

     

    Can you add some comments on why I'm getting that error OR is there anything wrong n my code above?

     

     

    Friday, July 06, 2007 10:38 AM
  • Depending on the version of Office and Windows, there is a maximum size image that can be copied. I'm not sure of the details, but it is related to this information on the PPT FAQ web site:

     

    http://pptfaq.com/FAQ00068.htm

     

    Even though PowerPoint is not involved in your problem, I've seen the copy/paste limitation in other circumstances.

    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Tutorials and Custom Solutions
    Peltier Technical Services, Inc. - http://PeltierTech.com
    _______
    Friday, July 06, 2007 12:26 PM
  • Thanks Jon.

     

    I visited the link you gave and it discusses virtually the same issue. I could not get the exact information on the limits from any of the Microsoft's site.

     

    Anyway, I have handled that in my code to display a user-friendly message if such an exception is thrown.

     

    - Amit

    Friday, July 06, 2007 12:37 PM
  • I've stopped using the copy range & paste as GIF approach because this will vary from computer to computer depending the end users' screen resolution.  I could not ensure a consistent end-user experience from computer to computer.

    I still have to paste charts into Userforms, and that has the same issues.  Our company issues the same laptop and LCD screen to all employees, so I can make some assumptions about the possible screen sizes - are they running 1600x1200 or something less, etc.  The conference rooms may have LCD projectors or hi-def 60" TV's.  That through a wrinkle into things because they have different aspect ratios and pixel pitches - so yet another yet another wrinkle.  I query the screen size (ie - is the screen size set to 1024x768, etc) and then set custom graph sizes for each screen resolution.  This meant the apps had to best tested and retested at various screen resolutions, and also in several conference rooms.  All that testing wasn't worth it...  The initial solution was pretty clean on the code side, but all the testing, etc., negated the benefits.

    If the code will only run on your computer or other computers with exactly the same screen size, resolution and pixel pitch (is the end user viewing at 72 or 96 DPI?), then copying the range as an image is viable.  If the app is going to a large audience with unknown screen types, then this approach probably won't work very well.  

    GIF's don't resize cleanly and the aspect ratio must be retained.  If you need to resize a GIF (presumably downsizing), try to to stick to 50% or 25%.  No fractional percents like 27.8%.  I tried to keep my screen grabs native at 100%, to figure out their size I would -

    1)  Copy the range manually
    2)  Open Photoshop
    3)  Create "New" and it would ask if I wanted to created a document of X/Y pixels
    4)  At that point I knew the X/Y pixel count
    5)  X pixels * .75 = screen points
    6)  If a range was 200 pixels x 300 pixels, then the graphic should be 150 wide x 225 height.  
    7)  If graphic container is bigger/smaller and stretched to fit is selected, then it will look distorted and/or pixelated.
    Friday, July 06, 2007 3:58 PM
  • Hi I tried doing as the previous posts, but i get a "run time Error '13'" Type Mismatch

    Y

    here is the Code:

     

    Code Block

    Sub SaveAsJpg()
    Dim Temporary_Chart As Chart
    Dim Temporary_Picture As PictureFormat
    Dim FName As String

     

    ActiveSheet.Range("A1:G17").CopyPicture Appearance:=xlScreen, Format:=xlPicture
     'Adding a chart, this is just a holding area for the copied range (eventually)
        Charts.Add

        ActiveChart.Location where:=xlLocationAsNewSheet

        Set Temporary_Chart = ActiveChart

       
        
        'Pasting it on top of chart
        Temporary_Chart.Paste

        Set Temporary_Picture = Selection
       

        'Placing some extra space around the image to keep things clean
            
        FName = ThisWorkbook.Path & "\NEW_PICTURE.gif"
       
        Temporary_Chart.Export Filename:=FName, FilterName:="gif"


    End Sub

     

     

    Thank you

    Thursday, November 22, 2007 4:14 AM
  • Hi,

    What is this line suppose to do?

        Set Temporary_Picture = Selection

    The error is caused by the object being of type PictureFormat and the selection of type Picture.
    Thursday, November 22, 2007 9:04 AM
  • Thank you another set of eyes always helps...

     

    initially i had the  code

    Code Block

     'Set Temporary_Picture = Selection
       

        'Placing some extra space around the image to keep things clean
        'With Temporary_Chart.Parent
            '.Width = Temporary_Picture.Width + 5
            '.Height = Temporary_Picture.Height + 5
        'End With

     

     

    but it didn't work for me  so added some ' to take out of the way for now, but i missed hat line

     

    Thanks

    Friday, November 23, 2007 3:07 AM
  • Disclaimer: I have some experiece with C++ but very limited experience with VBA.  

     

    I'm attempting to save each cell in Column C (starting at "C3") as a .gif with the file name being the Value (numerical) of Column A on the same row.  I would like the macro to run, creating individual .gif's, until it finds a null value in Column C.  Everytime I run the below code, I don't get any errors but the files are not saved to the directory. Any help would be greatly appreciated.

     

    Public Sub create_gif(ByVal CellName As String)

    Row = 3

    Dim Target As Range

       Do While Target(Row, 3).Value <> Null

    CellName = Target(Row, 1).Value

    Target(Row, 3).Export _

    Filename:="C:\GIFs\" & CellName & ".gif", Filtername:="GIF"

    Row = Row + 1

        Loop

    End Sub

     

    Thanks in advance.

     

    Wednesday, November 28, 2007 11:19 PM
  • I had found the solution from web site PastePicture.zip that API method able to save target range image to the Clip board and save it to BMP format. It is capable to support unreadable cells export to picture.



    '***************************************************************************
    '*
    '* MODULE NAME:     Paste Picture
    '* AUTHOR & DATE:   STEPHEN BULLEN, Office Automation Ltd
    '*                  15 November 1998
    '*
    '* CONTACT:         Stephen@oaltd.co.uk
    '* WEB SITE:        http://www.oaltd.co.uk
    '*
    '* DESCRIPTION:     Creates a standard Picture object from whatever is on the clipboard.
    '*                  This object can then be assigned to (for example) and Image control
    '*                  on a userform.  The PastePicture function takes an optional argument of
    '*                  the picture type - xlBitmap or xlPicture.
    '*
    '*                  The code requires a reference to the "OLE Automation" type library
    '*
    '*                  The code in this module has been derived from a number of sources
    '*                  discovered on MSDN.
    '*
    '*                  To use it, just copy this module into your project, then you can use:
    '*                      Set Image1.Picture = PastePicture(xlPicture)
    '*                  to paste a picture of whatever is on the clipboard into a standard image control.
    '*
    '* PROCEDURES:
    '*   PastePicture   The entry point for the routine
    '*   CreatePicture  Private function to convert a bitmap or metafile handle to an OLE reference
    '*   fnOLEError     Get the error text for an OLE error code
    '***************************************************************************

    Option Explicit
    Option Compare Text

    ''' User-Defined Types for API Calls

    '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

    '''Windows API Function Declarations

    'Does the clipboard contain a bitmap/metafile?
    Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long

    'Open the clipboard to read
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long

    'Get a pointer to the bitmap/metafile
    Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long

    'Close the clipboard
    Private Declare Function CloseClipboard Lib "user32" () As Long

    'Convert the handle into an OLE IPicture interface.
    Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long

    'Create our own copy of the metafile, so it doesn't get wiped out by subsequent clipboard updates.
    Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long

    'Create our own copy of the bitmap, so it doesn't get wiped out by subsequent clipboard updates.
    Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long

    'The API format types we're interested in
    Const CF_BITMAP = 2
    Const CF_PALETTE = 9
    Const CF_ENHMETAFILE = 14
    Const IMAGE_BITMAP = 0
    Const LR_COPYRETURNORG = &H4

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''' Subroutine: PastePicture
    '''
    ''' Purpose:    Get a Picture object showing whatever's on the clipboard.
    '''
    ''' Arguments:  lXlPicType - The type of picture to create.  Can be one of:
    '''                          xlPicture to create a metafile (default)
    '''                          xlBitmap to create a bitmap
    '''
    ''' Date        Developer           Action
    ''' --------------------------------------------------------------------------
    ''' 30 Oct 98   Stephen Bullen      Created
    ''' 15 Nov 98   Stephen Bullen      Updated to create our own copies of the clipboard images
    '''

    Function PastePicture(Optional lXlPicType As Long = xlPicture) As IPicture

    'Some pointers
    Dim h As Long, hPicAvail As Long, hPtr As Long, hPal As Long, lPicType As Long, hCopy As Long

    'Convert the type of picture requested from the xl constant to the API constant
    lPicType = IIf(lXlPicType = xlBitmap, CF_BITMAP, CF_ENHMETAFILE)

    'Check if the clipboard contains the required format
    hPicAvail = IsClipboardFormatAvailable(lPicType)

    If hPicAvail <> 0 Then
        'Get access to the clipboard
        h = OpenClipboard(0&)

        If h > 0 Then
            'Get a handle to the image data
            hPtr = GetClipboardData(lPicType)

            'Create our own copy of the image on the clipboard, in the appropriate format.
            If lPicType = CF_BITMAP Then
                hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
            Else
                hCopy = CopyEnhMetaFile(hPtr, vbNullString)
            End If

            'Release the clipboard to other programs
            h = CloseClipboard

            'If we got a handle to the image, convert it into a Picture object and return it
            If hPtr <> 0 Then Set PastePicture = CreatePicture(hCopy, 0, lPicType)
        End If
    End If

    End Function


    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''' Subroutine: CreatePicture
    '''
    ''' Purpose:    Converts a image (and palette) handle into a Picture object.
    '''
    '''             Requires a reference to the "OLE Automation" type library
    '''
    ''' Arguments:  None
    '''
    ''' Date        Developer           Action
    ''' --------------------------------------------------------------------------
    ''' 30 Oct 98  Stephen Bullen      Created
    '''

    Private Function CreatePicture(ByVal hPic As Long, ByVal hPal As Long, ByVal lPicType) As IPicture

    ' IPicture requires a reference to "OLE Automation"
    Dim r As Long, uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPicture

    'OLE Picture types
    Const PICTYPE_BITMAP = 1
    Const PICTYPE_ENHMETAFILE = 4

    ' Create the Interface GUID (for the IPicture interface)
    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 = IIf(lPicType = CF_BITMAP, PICTYPE_BITMAP, PICTYPE_ENHMETAFILE)  ' Type of Picture
        .hPic = hPic                                                            ' Handle to image.
        .hPal = IIf(lPicType = CF_BITMAP, hPal, 0)                              ' Handle to palette (if bitmap).
    End With

    ' Create the Picture object.
    r = OleCreatePictureIndirect(uPicInfo, IID_IDispatch, True, IPic)

    ' If an error occured, show the description
    If r <> 0 Then Debug.Print "Create Picture: " & fnOLEError(r)

    ' Return the new Picture object.
    Set CreatePicture = IPic

    End Function

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''' Subroutine: fnOLEError
    '''
    ''' Purpose:    Gets the message text for standard OLE errors
    '''
    ''' Arguments:  None
    '''
    ''' Date        Developer           Action
    ''' --------------------------------------------------------------------------
    ''' 30 Oct 98   Stephen Bullen      Created
    '''

    Private Function fnOLEError(lErrNum As Long) As String

    'OLECreatePictureIndirect return values
    Const E_ABORT = &H80004004
    Const E_ACCESSDENIED = &H80070005
    Const E_FAIL = &H80004005
    Const E_HANDLE = &H80070006
    Const E_INVALIDARG = &H80070057
    Const E_NOINTERFACE = &H80004002
    Const E_NOTIMPL = &H80004001
    Const E_OUTOFMEMORY = &H8007000E
    Const E_POINTER = &H80004003
    Const E_UNEXPECTED = &H8000FFFF
    Const S_OK = &H0

    Select Case lErrNum
    Case E_ABORT
        fnOLEError = " Aborted"
    Case E_ACCESSDENIED
        fnOLEError = " Access Denied"
    Case E_FAIL
        fnOLEError = " General Failure"
    Case E_HANDLE
        fnOLEError = " Bad/Missing Handle"
    Case E_INVALIDARG
        fnOLEError = " Invalid Argument"
    Case E_NOINTERFACE
        fnOLEError = " No Interface"
    Case E_NOTIMPL
        fnOLEError = " Not Implemented"
    Case E_OUTOFMEMORY
        fnOLEError = " Out of Memory"
    Case E_POINTER
        fnOLEError = " Invalid Pointer"
    Case E_UNEXPECTED
        fnOLEError = " Unknown Error"
    Case S_OK
        fnOLEError = " Success!"
    End Select

    End Function









    --Paste below coding to new module--

    Declare Function SystemParametersInfo Lib "user32" _
       Alias "SystemParametersInfoA" (ByVal uAction As Long, _
       ByVal uParam As Long, ByVal lpvParam As Any, _
       ByVal fuWinIni As Long) As Long
     
    Public Const SPI_SETDESKWALLPAPER = 20
     
    Public Const SPIF_SENDWININICHANGE = &H2
     
    Public Const SPIF_UPDATEINIFILE = &H1
     
    Public Sub SetWallpaper(ByVal FileName As String)
     
      Dim x As Long
     
      x = SystemParametersInfo(SPI_SETDESKWALLPAPER, _
      0&, FileName, SPIF_SENDWININICHANGE Or SPIF_UPDATEINIFILE)
       
    End Sub

    Sub PrintDesktop(ByRef xlrng As Excel.Range, ByVal strFileName As String)
     
        Dim oPic As IPictureDisp
      
        xlrng.CopyPicture xlScreen, xlBitmap
        Set oPic = PastePicture(xlBitmap)
        'Fname = "C:\iFlash.bmp"
        SavePicture oPic, strFileName
       
     
    End Sub


    Thursday, November 29, 2007 3:08 AM
  •  

    You left out the actual export step:

     

    Code Block

    Public Sub create_gif(ByVal CellName As String)

    Row = 3

    Dim Target As Range

       Do While Target(Row, 3).Value <> Null

    CellName = Target(Row, 1).Value

    Target(Row, 3).Export _

    ActiveSheet.Chartobjects(Row).Export Filename:="C:\GIFs\" & CellName & ".gif", Filtername:="GIF"

    Row = Row + 1

        Loop

    End Sub

     

     

    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Tutorials and Custom Solutions
    Peltier Technical Services, Inc. - http://PeltierTech.com
    _______

    Thursday, November 29, 2007 3:34 AM
  • Thanks for the quick responses.

     

    I think my code has caused a little confusion as to what I am attempting to accomplish.  With futher research, it has become my understanding that the Export Method applies strictly to Charts.  In this case, I am not attempting to export a chart, but instead I want to save selected cells within a range as .gif files and export them to a given directory.  I have had a difficult time finding any information as to how to go about this.  I was able to find an application "ExTools" which allows the user to do precisely what I am looking for (Save Selection as Picture), but on a lesser scale than what is needed.

     

    Hopefully that helps clear things up, and sorry for the confusion.

     

    Thanks again for any assistance you can provide.

    Friday, November 30, 2007 1:47 AM
  •  

    Go back to the post by Quadra950 on 12 Sept 06. He shows how to create a temporary chart, copy the range as a picture, paste it into the chart, and export the chart containing the picture of the range.

     

    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Tutorials and Custom Solutions
    Peltier Technical Services, Inc. - http://PeltierTech.com
    _______
    Friday, November 30, 2007 11:45 AM
  • I dont know how I missed that post, but it put me in the perfect direction.

     

    Thanks for all of the help!

     

    Friday, November 30, 2007 11:11 PM
  • Hi again all,

     

    I am attempting to use the below code to create and save the content of individual cells containing Arabic Text as GIFs.  For some reason, when the GIF is created, the resulting image does not match the cell exactly.  Some characters appear to be transposed while others look completely different.   I have ruled out the code for trimming as the problem by running the macro with that section commented out.  The code appears to work fine for English text, even with special characters.  I'm not sure if there is an issue with my code, or if I need to have Arabic installed on my computer in order for this to work properly.  Any ideas?

     

     

    Code Block

    Sub SaveAsGIF()

    Dim Temporary_Worksheet As Worksheet

    Dim Temporary_Chart As Chart

    Dim Temporary_Picture As Picture

    Dim CellName As String

    Dim Count As Integer

    Dim Length As Long

    Dim CLength As Integer

    Dim StrTemp As String

    Dim StrPrev As String

    Dim TrimMyText As String

    Row = 3

     

    Do While ThisWorkbook.Sheets("Sheet1").Cells(Row, 3).Value <> ""

    ThisWorkbook.Sheets("Sheet1").Cells(Row, 3).HorizontalAlignment = xlLeft

    Count = 1

    ActiveWindow.DisplayGridlines = False

    Application.DisplayAlerts = True

    CellName = ThisWorkbook.Sheets("Sheet1").Cells(Row, 1).Value

    Length = Len(ThisWorkbook.Sheets("Sheet1").Cells(Row, 3))

    TrimMyText = ""

     

    ' Removes any unnecessary spaces

    ThisWorkbook.Sheets("Sheet1").Cells(Row, 3) = Trim(ThisWorkbook.Sheets("Sheet1").Cells(Row, 3))

    CLength = 1

    If Length > 1 Then

    Do While CLength <= Length

    StrTemp = Mid(ThisWorkbook.Sheets("Sheet1").Cells(Row, 3), CLength, 1)

    If StrTemp <> " " Then

    TrimMyText = TrimMyText & StrTemp

    End If

    If StrTemp = " " Then

    StrPrev = Mid$(ThisWorkbook.Sheets("Sheet1").Cells(Row, 3), CLength - 1, 1)

    If StrPrev = vbCrLf Then

    TrimMyText = TrimMyText

    End If

    If StrPrev <> " " Then

    TrimMyText = TrimMyText & StrTemp

    End If

    End If

    CLength = CLength + 1

    Loop

    End If

    ThisWorkbook.Sheets("Sheet1").Cells(Row, 3).Value = TrimMyText

     

    'Counts Carriage Returns

    With CreateObject("vbscript.regexp")

    .Pattern = Chr$(10)

    .Global = True

    Count = Count + .Execute(ThisWorkbook.Sheets("Sheet1").Cells(Row, 3).Value).Count

    End With

     

    'Adding a temporary worksheet

    Set Temporary_Worksheet = Worksheets.Add

     

    'Adding a chart, this is just a holding area for the copied range (eventually)

    Charts.Add

    ActiveChart.Location Where:=xlLocationAsObject, Name:=Temporary_Worksheet.Name

    Set Temporary_Chart = ActiveChart

     

    'Copying my range

    ThisWorkbook.Sheets("Sheet1").Cells(Row, 3).CopyPicture Appearance:=xlScreen, Format:=xlPicture

    'Pasting it on top of chart

    Temporary_Chart.Paste

    Set Temporary_Picture = Selection

    'Placing some extra space around the image to keep things clean

    With Temporary_Chart.Parent

    .Width = Temporary_Picture.Width + 5

    .Height = Temporary_Picture.Height + 5

    .Interior.ColorIndex = xlNone

     

    ' Setting Background to Solid White and 100% Transparent

    Selection.ShapeRange.Fill.Visible = msoTrue

    Selection.ShapeRange.Fill.Solid

    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9

    Selection.ShapeRange.Fill.Transparency = 1#

    Selection.ShapeRange.Line.Weight = 0.75

    Selection.ShapeRange.Line.DashStyle = msoLineSolid

    Selection.ShapeRange.Line.Style = msoLineSingle

    Selection.ShapeRange.Line.Transparency = 0#

    Selection.ShapeRange.Line.Visible = msoFalse

    End With

     

    'Export file to Directory

    Temporary_Chart.Export Filename:="C:\Test" & CellName & "_" & Count & ".gif", FilterName:="GIF"

     

    'Delete Sheet with Temporary Chart

    Application.DisplayAlerts = False

    ActiveSheet.Delete

     

    Row = Row + 1

    Loop

    ActiveWindow.DisplayGridlines = True

    End Sub

     

     

    Thanks for the help,

    - CP  

     

    Thursday, December 06, 2007 11:14 PM
  • Please disregard.  Turns out it was because Arabic was not installed as a supplemental language on my computer.

    Monday, December 10, 2007 11:40 PM
  • Hi again all, 

    Thanks again for all the help thus far, this has been quite an experience.  I am currently trying to save the exported chart as a jpg with no border (outline), but I am having absolutely no success. I'm not sure what it is that I'm doing wrong, but all of the images have an outline. Can anyone help me here? Please!


    Code Block
    Sub SaveAsJPG()

    Dim Temporary_Worksheet As Worksheet
    Dim Temporary_Chart As Chart
    Dim Temporary_Picture As Picture
    Dim CellName As String
    Dim Count As Integer
    Dim Length As Long
    Dim CLength As Integer
    Dim StrTemp As String
    Dim StrPrev As String
    Dim TrimMyText As String

    Row = 3

    Do While ThisWorkbook.Sheets("Sheet1").Cells(Row, 3).Value <> ""
    ThisWorkbook.Sheets("Sheet1").Cells(Row, 3).HorizontalAlignment = xlLeft
    Count = 1
    ActiveWindow.DisplayGridlines = False
    Application.DisplayAlerts = True
    CellName = ThisWorkbook.Sheets("Sheet1").Cells(Row, 1).Value
    Length = Len(ThisWorkbook.Sheets("Sheet1").Cells(Row, 3))
    TrimMyText = ""

    ' Removes any unnecessary spaces
    ThisWorkbook.Sheets("Sheet1").Cells(Row, 3) = Trim(ThisWorkbook.Sheets("Sheet1").Cells(Row, 3))
    CLength = 1
    If Length > 1 Then
    Do While CLength <= Length
    StrTemp = Mid(ThisWorkbook.Sheets("Sheet1").Cells(Row, 3), CLength, 1)
    If StrTemp <> " " Then
    TrimMyText = TrimMyText & StrTemp
    End If

    If StrTemp = " " Then
    StrPrev = Mid$(ThisWorkbook.Sheets("Sheet1").Cells(Row, 3), CLength - 1, 1)
    If StrPrev = vbCrLf Then
    TrimMyText = TrimMyText
    End If
    If StrPrev <> " " Then
    TrimMyText = TrimMyText & StrTemp
    End If
    End If
    CLength = CLength + 1
    Loop
    End If

    ThisWorkbook.Sheets("Sheet1").Cells(Row, 3).Value = TrimMyText

    'Counts Carriage Returns
    With CreateObject("vbscript.regexp")
    .Pattern = Chr$(10)
    .Global = True
    Count = Count + .Execute(ThisWorkbook.Sheets("Sheet1").Cells(Row, 3).Value).Count
    End With


    'Adding a temporary worksheet
    Set Temporary_Worksheet = Worksheets.Add

    'Adding a chart, this is just a holding area for the copied range (eventually)
    Charts.Add

    ActiveChart.Location Where:=xlLocationAsObject, Name:=Temporary_Worksheet.Name

    Set Temporary_Chart = ActiveChart

    'Copying my range
    ThisWorkbook.Sheets("Sheet1").Cells(Row, 3).CopyPicture Appearance:=xlScreen, Format:=xlPicture

    'Pasting it on top of chart
    Temporary_Chart.Paste

    Set Temporary_Picture = Selection

    'Placing some extra space around the image to keep things clean
    With Temporary_Chart.Parent
    .Width = Temporary_Picture.Width + 5
    .Height = Temporary_Picture.Height + 5
    .Interior.ColorIndex = xlNone
    ' Setting Background to Solid White and 100% Transparent
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
    Selection.ShapeRange.Fill.Transparency = 1#
    Selection.ShapeRange.Line.Weight = 0#
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 1#
    Selection.ShapeRange.Line.Visible = msoFalse
    End With

    'Export file to Directory
    Temporary_Chart.Export Filename:="C:\Documents and Settings\chris\Desktop\PL# 129542 Translation GIFs\Test JPGs\" & CellName & "_" & Count & ".jpg", FilterName:="JPG"

    'Delete Sheet with Temporary Chart
    Application.DisplayAlerts = False
    ActiveSheet.Delete

    Row = Row + 1

    Loop

    ActiveWindow.DisplayGridlines = True

    End Sub

     

     


    Thanks in advance,
    - CP
    Tuesday, December 11, 2007 10:52 PM
  • 1. In most cases, exporting as PNG or GIF will result in better looking images than exporting as JPG.

     

    2. Remove the border on the chart before exporting:

     

        Temporary_Chart.Border.LineStyle = 0


    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Tutorials and Custom Solutions
    Peltier Technical Services, Inc. - http://PeltierTech.com
    _______

    Tuesday, December 11, 2007 11:08 PM
  • That worked awesome!  Thanks for the help Jon.

    Wednesday, December 12, 2007 4:00 PM
  • Microsoft document image writer appears as an optional printer on most pc's. This will print to file as a tif (go into printer properties and select resolution and default destination of file). Then open the tif in any picture editing program and re-save as a jpg.
    Wednesday, June 09, 2010 11:45 AM
  • The simplest solution is: select the chart (I assume thsi is about getting a chart into work), hold down the shift key, click on "Edit", this will give you a "Copy picture" option, select it, paste into your word document.
    Tuesday, July 06, 2010 3:02 PM
  • I know a good tool to solve your problem. Have a try! http://download.cnet.com/Excel-To-Jpeg-Converter-3000/3000-2077_4-10920695.html
    Wednesday, December 08, 2010 6:33 AM
  • Hey Perry,

     

    • Copy the desired cells in the Excel sheet that you're working on.
    • In MS Word, click the arrow under "Paste" which is to the top left of your screen.
    • Select "Paste Special" and then select the desired format (jpg, bmp, etc.)

     

    Cheers,

    KC

    Sunday, February 13, 2011 9:19 PM
  • Hi Jon,

     

    Do you any idea how to convert  Word document selected range as an image!

    I have tried it copies data to the clipboad but failed to save as an image.

    Link for my issue ::: http://social.msdn.microsoft.com/Forums/sr-Latn-CS/officegeneral/thread/5413d65f-722d-4aef-b276-fa5b09de2edc

    Could you please help on this?

    Thank you very much,

     

     

    • Proposed as answer by justinr360 Sunday, June 12, 2011 3:37 AM
    • Unproposed as answer by justinr360 Sunday, June 12, 2011 3:37 AM
    Wednesday, March 02, 2011 3:48 PM
  • There's a lot of complicated looking stuff here that looks like a pain. I propose a simple solution which I just found. I simply copied all the cells I wanted to be in the jpg picture, opened up MS Paint, and pasted. Showed up looking just like it did in Excel.

    I'm not sure if it makes a difference here, but I'm using Office '07 in Vista Ultimate, so I won't guarantee it works the same for other versions of Windows/Office.

    Sunday, June 12, 2011 3:42 AM
  • For MSWord 2003 I had to create images of certain pages not selected areas.  I automated this using free command line tools.   I used PDF Creator to make a .ps file of the document, ghostscript to create jpg images of each page and ImageMagick to scale/crop the images.   I create a form with button images of the pages so the user can select the desired pages.

    posting date

    • Edited by mogulman52 Tuesday, June 14, 2011 10:26 PM date
    Sunday, June 12, 2011 4:50 PM
  • I just want to say thanks to all who contributed to this thread.

    Below is the final code I came up with (additions outlined):

    • I defined a Range command so that the chart object would resize to the selection
    • I removed the chart border
    • Temporary sheet is deleted to make the final book cleaner

    Sub ImageExport()
    
        Dim FName As String
        Dim Temporary_Worksheet As Worksheet
        Dim Temporary_Chart As Chart
        Dim ImageSize As Range
        
        'Determine size
        Set ImageSize = ThisWorkbook.Sheets("Summary").Range("C12:S74")
        
        'Adding a temporary worksheet
        Set Temporary_Worksheet = Worksheets.Add
    
        'Adding a chart, this is just a holding area for the copied range (eventually)
        Charts.Add
    
        ActiveChart.Location Where:=xlLocationAsObject, Name:=Temporary_Worksheet.Name
    
        Set Temporary_Chart = ActiveChart
    
        'Copying my range
        ThisWorkbook.Sheets("Summary").Range("C12:S74").CopyPicture Appearance:=xlScreen, Format:=xlPicture
        
        'Placing some extra space around the image to keep things clean
        With Temporary_Chart.Parent
            .Width = ImageSize.Width
            .Height = ImageSize.Height
        End With
        
        'Pasting it on top of chart
        Temporary_Chart.Paste
        
        With Temporary_Chart
            .ChartArea.Border.LineStyle = 0
        End With
            
        Temporary_Chart.Export Filename:="C:\MyDesktop\Automation\Images\CCUpdate.gif", FilterName:="gif"
        
        Application.DisplayAlerts = False
        ActiveSheet.Delete
        Application.DisplayAlerts = True
    
    
    End Sub


    • Edited by Dan12456 Monday, September 12, 2011 1:15 PM
    Monday, September 12, 2011 1:14 PM
  • If I understand your question, here is how I would go about it: 1. Highlight the portion of the Excel sheet you want to copy 2. Hold down Shift and click the Edit menu. 3. Click Copy Picture (us two defaults selected) 4. Paste into microsoft paint Hope this helps. thx frnd.....i was having another prblm but the above suggestion helped me solve my prblm....''i wanted to save a web page as a picture ,i first opend the web page in microsoft exel and then followed the above steps and pasted it in microsoft paint and saved it................thx bro ,thx alot
    • Edited by umairuzi Thursday, November 24, 2011 2:46 PM
    Thursday, November 24, 2011 2:41 PM
  • If I understand your question, here is how I would go about it: 1. open your microsft word file in microsoft excel 2. Highlight the portion of the Excel sheet you want to copy 3. Hold down Shift and click the Edit menu. 4. Click Copy Picture (us two defaults selected) 5. Paste into microsft paint 6. save file ""save as"" Hope this helps.
    • Proposed as answer by umairuzi Thursday, November 24, 2011 2:51 PM
    Thursday, November 24, 2011 2:48 PM
  • hi,
     
    Sub convert_the_selection_into_a_gif_file()
    t = Selection.Top
    l = Selection.Left
    w = Selection.Width
    h = Selection.Height
    Selection.CopyPicture xlScreen, xlPicture 'Adapter la plage
    Sheets.Add
    ActiveSheet.Paste Destination:=Range("A1")
            With ActiveSheet
            .Range("A1").CopyPicture
            .Paste
            .ChartObjects.Add(t, l, w, h).Chart.Paste
            .ChartObjects(1).Chart.Export "c:\testImage1.gif", "gif" 'Adapter le répertoire
            End With
        Application.DisplayAlerts = False
        ActiveSheet.Delete
        Application.DisplayAlerts = True
    End Sub
     
    --
    isabelle
     
    Thursday, November 24, 2011 3:09 PM
  • Very easy, do go for any software or add ons. I had a problem to get excel worksheet to Adobe InDesign. Tried pdf format but the result was'nt impressive. Then I came acroos a simple solution so dont waste time here and there Just simply follow the procedure:-

    In Excel 2003 there's a little trick. Hold down the Shift key and choose Edit from the menu. Note that instead of Copy it offers Copy Picture—select that item. You'll be asked whether to copy as Picture or Bitmap, and whether to copy the image As shown on screen or As printed. You'll almost always want to choose Bitmap and As shown on screen. If you choose Picture, the image will be copied as a resizable Windows Metafile, and not all programs can use that format.

    Naturally, it's different in Excel 2007. To copy a range as a picture, in the Home ribbon's Clipboard pane click the Down arrow under Paste, choose As Picture from the menu, and then Copy as Picture. (If you're surprised at having to choose Paste when you want to copy, remember this is coming from the same company that makes you click Start when you want to shut down.) As in Excel 2003, you'll generally want to copy it as Bitmap and As shown on screen.

    Hope u like it.

    Tuesday, May 22, 2012 3:50 PM