copy

Wednesday, 19 September 2012



Export Excel Charts As TIFF images Using Adobe Professional

In this post, I will present the VBA code that I wrote for Jim from Nebraska (USA). Jim read my previous post about the VBA offer, sent me an email and asked me if there is a way to export some Excel charts as high-quality TIFF images. My straight answer was that this is not possible directly from Excel. Although it is possible to export an Excel chart as PNG, GIF, JPG, JPE and JPEG image using a single line of VBA code - ActiveChart.Export “C:\Test.jpeg” for example – it is not possible to export as TIFF file.

My first thought was to use PowerPoint. I could copy the charts to a PowerPoint presentation and then export as TIFF files since PowerPoint has this feature (while Excel not). However, although I found a way to improve the quality of TIFF images up to 300 dpi (see here how you can do it), I was not satisfied with the result. Moreover, the particular solution required registry intervention something that may trouble inexperienced users.

After rejecting the solution of PowerPoint, I thought that I could try Adobe Professional. Since Jim had this software installed on his computer I started writing some VBA code. In my first trials, the macro performed the following: print the active chart as pdf, open the pdf, use the crop box to cut the white margins and then save the file as TIFF image. I used the “AcroExch.Rect” object, and by trial and error, I found the required rectangle dimensions that matched the chart dimensions (see sample code below).

       'There is more code before.
       'Set the PDDoc object.
        Set acroPDDoc = acroAVDoc.GetPDDoc()       

        'Set the rectangle and populate it.
        Set acroRect = CreateObject("AcroExch.Rect")
        acroRect.Top = 572
        acroRect.Left = 53
        acroRect.bottom = 271
        acroRect.Right = 574
        
        'Crop pages – 0 is the page 1.
        acroTextCrop = acroPDDoc.CropPages(0, 0, 0, acroRect)
       'There is more code below.



Update 29/6/2013: The code below works with Adobe Professional X or older versions. If you use version XI (or newer) try this code. Starting from version XI Adobe has changed the shortcut for showing the crop window from CTRL + SHIFT + T to C + double mouse (left) click, so the code below will FAIL. The newer code doesn't use the sendkeys method!


How to do it

In my initial solution, there was a severe malfunction: if the chart has different dimensions the crop box was either unable to cut the white margins or some part of the graph was cut. In Adobe Professional there is an option to remove the white margins automatically. However, I couldn’t find this option programmatically. So, what was my final solution? “Sendkeys method”! I simulated keyboard shortcuts that open the crop box, enable the remove white margins checkbox and then press the OK button – in one line this is “translated” to  SendKeys ("^+TZW{ENTER}"). You can find the complete code below:

Option Explicit

Sub ChartAsTiff()
    
    'This macro converts a chart to pdf and then uses Adobe Professional
    'to crop the pdf (using the sendkeys method), save it as tiff file and then deletes the pdf.
    'The tiff file is named either with the chart title (if exists) or with the chart name.
    
    'In order to use the macro you must enable the Acrobat library from VBA editor:
    'Go to Tools -> References -> Adobe Acrobat xx.0 Type Library, where xx depends
    'on your Acrobat Professional version (i.e. 9.0 or 10.0) you have installed to your PC.
    
    'Alternatively you can find it Tools -> References -> Browse and check for the path
    'C:\Program Files\Adobe\Acrobat xx.0\Acrobat\acrobat.tlb
    'where xx is your Acrobat version (i.e. 9.0 or 10.0 etc.).
    
    'Note: the macro does NOT work with Acrobat Reader!
    'By Christos Samaras
        
    'Declararing the necessary variables.
    Dim strChTitle          As String
    Dim strChFullName       As String
    Dim strPdfPath          As String
    Dim strTiffPath         As String
    Dim strChOrient         As String
    Dim arrSpecialChar()    As String
    Dim dblSpCharFound      As Double
    Dim i                   As Integer
    Dim objAcroApp          As New Acrobat.acroApp
    Dim objAcroAVDoc        As New Acrobat.acroAVDoc
    Dim objAcroPDDoc        As Acrobat.acroPDDoc
    Dim objAcroPDPage       As Acrobat.AcroPDPage
    Dim objAcroPoint        As Acrobat.AcroPoint
    Dim objJSO              As Object
    Dim boResult            As Boolean
    
    On Error GoTo errorHandler
    
    'Check if a chart is selected.
    If ActiveChart Is Nothing Then
        MsgBox "Please select a chart first and retry!", vbCritical, "Chart not selected"
        Exit Sub
    End If
    
    With Application
        .ScreenUpdating = False
        .StatusBar = "Please wait, the conversion is in progress..."
    End With
    
    'An array with special characters that cannot be used for naming a file.
    'For some unknown reason, even comma raises an error during saving as tiff.
    arrSpecialChar() = Split("\ / : , * ? " & Chr$(34) & " < > |", " ")
        
    'Check if chart's title exists.
    On Error Resume Next
    strChTitle = ActiveChart.ChartTitle.Caption
        If strChTitle <> "" Then
            strChFullName = ActiveWorkbook.Path & "\" & ActiveChart.ChartTitle.Caption
            'Check if the chart caption contains a special character.
            For i = LBound(arrSpecialChar) To UBound(arrSpecialChar)
                dblSpCharFound = WorksheetFunction.Find(arrSpecialChar(i), strChTitle)
                If dblSpCharFound > 0 Then
                    strChFullName = ActiveWorkbook.Path & "\" & ActiveChart.Name
                End If
            Next i
        Else
            strChFullName = ActiveWorkbook.Path & "\" & ActiveChart.Name
        End If
    On Error GoTo 0
    
    'Export the chart as pdf in the same folder with the excel file.
    With ActiveChart
        'Check the page orientation.
        strChOrient = .PageSetup.Orientation
        .PageSetup.PaperSize = xlPaperA4
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=strChFullName, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With
    
    'Set the paths of pdf and tiff file.
    strPdfPath = strChFullName & ".pdf"
    strTiffPath = strChFullName & ".tiff"
    
    'Open the pdf file.
    ActiveWorkbook.FollowHyperlink strPdfPath, NewWindow:=True
    
    'Set the necessary acrobat objects.
    Set objAcroAVDoc = objAcroApp.GetActiveDoc
    Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
    
    'The first page has number 0.
    Set objAcroPDPage = objAcroPDDoc.AcquirePage(0)
    Set objAcroPoint = objAcroPDPage.GetSize
    
    'The code below uses the sendkeys method to simulate the following movements:
    'Open the crop menu (CRL + SHIFT + T), set to zero (Z), remove white
    'margin (W) and finally OK (ENTER). It repeats a loop until the page size
    'becomes less than A4 size (in points), which means that page has been
    'cropped successfully.
    If strChOrient = "1" Then
        Do While objAcroPoint.x > 580
            SendKeys ("^+TZW{ENTER}"), True
            Set objAcroPoint = objAcroPDPage.GetSize
        Loop
    Else
        Do While objAcroPoint.y > 580
            SendKeys ("^+TZW{ENTER}"), True
            Set objAcroPoint = objAcroPDPage.GetSize
        Loop
    End If
            
    'Set the JS Object - Java Script Object.
    Set objJSO = objAcroPDDoc.GetJSObject
    
    'Save the pdf file as tiff.
    boResult = objJSO.SaveAs(strTiffPath, "com.adobe.acrobat.tiff")
    
    'Close the pdf without saving the changes.
    objAcroAVDoc.Close (True)
    
    'Release the objects.
    Set objJSO = Nothing
    Set objAcroPoint = Nothing
    Set objAcroPDPage = Nothing
    Set objAcroPDDoc = Nothing
    Set objAcroAVDoc = Nothing
    Set objAcroApp = Nothing
            
    'Delete the pdf file.
    On Error Resume Next
    Kill strPdfPath
    On Error GoTo 0
        
    'Inform the user that the work was done.
    MsgBox "You can find the tiff file of the chart at the path:" & vbNewLine _
    & strTiffPath, vbInformation, "Done"
    
    With Application
        .ScreenUpdating = True
        .StatusBar = False
    End With
    
errorHandler:
    Set objJSO = Nothing
    Set objAcroPoint = Nothing
    Set objAcroPDPage = Nothing
    Set objAcroPDDoc = Nothing
    Set objAcroAVDoc = Nothing
    Set objAcroApp = Nothing
    Exit Sub
    
End Sub

Here is another macro that loops through all embedded charts and chart sheets and uses the ChartAsTiffNoMsg macro to convert the charts to pdfs and then to tiff files. ChartAsTiffNoMsg is similar to ChartAsTiff macro but without the message box at the end.

Option Explicit

Sub ExportAllCharts()
    
    'This macro converts all charts in the workbook to tiff files.
    'It loops through all embedded charts and chart sheets and uses
    'the ChartAsTiffNoMsg macro to convert the chart to pdf and then to tiff.

    'By Christos Samaras

    Dim objCh As Object
    Dim ws As Worksheet
    
    With Application
        .ScreenUpdating = False
        .StatusBar = "Please wait, the conversion is in progress..."
    End With
    
    'Loop through all embedded charts in all sheets of the workbook.
    For Each ws In ActiveWorkbook.Worksheets
        For Each objCh In ws.ChartObjects
            objCh.Activate
            Call ChartAsTiffNoMsg
        Next objCh
    Next ws
    
    'Loop through all chart sheets.
    For Each objCh In ActiveWorkbook.Charts
        objCh.Activate
        Call ChartAsTiffNoMsg
    Next objCh
    
    With Application
        .ScreenUpdating = True
        .StatusBar = False
    End With
    
    'Inform the user that the work was done.
    MsgBox "All charts where exported as Tiff files!", vbInformation, "Done"
    
End Sub


How to use it 

The short video below demonstrates the two macros in use. 


This is not an optimal solution. The ideal solution would not require the conversion to pdf. Furthermore, the sendkeys method has a severe shortcoming: when the macro runs, the user must not use the keyboard because it is possible to corrupt the macro. However, the above macros work… So, people who have Acrobat Professional can use this VBA code to export their Excel charts as TIFF files. I believe that students will appreciate this code since many journals require exclusively TIFF images (not JPEG or PNG). So, thanks Jim for the project proposal. It was a quite exciting and challenging project! I hope that you are satisfied with the result.

Note that the offer is still open, so if any of you have an interesting project to suggest, send me an email…


Download it from here


The file can be opened with Office 2007 or newer. Please, remember to enable macros before using it.


Read also

Export Chart(s) As TIFF Image(s) Using Adobe Professional XI
VBA Macro To Open A PDF File
Open PDF File With VBA
VBA Macro To Convert PDF Files Into Different Format 

Did you like this post? If yes, then share it with your friends. Thank you!


Categories:


Mechanical Engineer (Ph.D. cand.), M.Sc. Cranfield University, Dipl.-Ing. Aristotle University, Thessaloniki - Greece.
Communication: e-mail, Facebook, Twitter, Google+ and Linkedin. More info