copy

Saturday, 29 June 2013



Export Chart As TIFF Image Using Adobe Professional XI

Introduction

Almost a year ago I posted a VBA code for exporting Excel charts as high quality TIFF pictures using Adobe Professional. Judging from some feedback that I received via email the code was working fine and a lot of people used it to create TIFF files for various scientific journals. However, Adobe decided to make our lives difficult! At previous October (2012) Adobe released a new version of Professional – the version XI (or 11.0) – making that code useless...

To tell you the truth, until this week I was not aware of the problem since I had an older Adobe Professional version installed on my computer (10.0). Thanks to an email that I received from a blog reader (Tammy) I installed the newer version (11.0 or XI) and tried to run my old code. Since I was getting an error, I decided to write a new code in order to fix it.


The shortcut problem with version XI

My old code was based on sendkeys method to pop up the crop window of Adobe Professional and then enable the “remove white margin” checkbox and press the OK button. All this procedure was being done by the following line of VBA code: SendKeys ("^+TZW{ENTER}"), True. Until version X (10.0) the shortcut in order to show the crop window was CTRL + SHIFT + T. However, starting from the last Adobe Professional version (XI or 11.0), Adobe changed this shortcut to: C + double (left) mouse click. So, my old code was unable to work with version XI due to this shortcut change!

As I have pointed out many times in the past, the sendkeys method is quite unreliable and should be avoided. So, in the new code I decided to follow a different concept; I replaced the sendkeys method with a combination of various API functions (FindWindow, FindWindowEx, SetForegroundWindow, Sleep, SendMessage, keybd_event, mouse_event) in order to make the code more reliable and robust. The idea is not new. I have applied it to a previous code for opening a PDF file using VBA.


Prerequisites to run the VBA code

First of all, in order to use the "C + double mouse click" shortcut in order to show the crop window in Adobe Professional XI you must have enabled the so-called “single-key accelerators”, otherwise the code will NOT work. How to enable them? Well, just follow the two-step procedure below:

Adobe Preferences

a. Open Adobe Professional and go to menu Edit → Preferences.

Enabling Single-Key Accelerators In Adobe Professional XI

b. On the Preferences window go to the “General” tab (1) → check the “Use single-key accelerator to access tools” checkbox (2) and then press OK (3).

Another thing to remember is that the code does NOT work with Adobe Reader, as well as with Adobe Professional version X (10.0) or older. The code below was written exclusively for Adobe Professional XI (11.0) and it might even work with newer versions of Adobe Professional, as long as the shortcut "C + double mouse click" is still valid. If you have an older Adobe Professional version, please try my previous code.


VBA code

This is the main procedure for saving a chart as PDF file, calling the crop procedure and finally save the cropped PDF file as a TIFF image:

Sub ChartAsTiff()
    
    '----------------------------------------------------------------------------------------------
    'This macro converts a chart to pdf and then uses Adobe Professional XI in order to
    'crop the pdf file (using API functions), 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.
    
    'IMPORTANT: since the new shortcut for showing the crop window is the "C" + double click,
    'before running the code open the Adobe Professional XI -> Edit -> Preferences -> General and
    'check the "Use Single-Key Accelerators To Access Tools". Otherwise the macro will NOT work!
    
    'Furthermore, 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. 10.0 or 11.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 (for 32bit Windows)
    'where xx is your Acrobat version (i.e. 10.0 or 11.0 etc.).
    
    'This code was designed and tested with Adobe Professional XI. However, it is known that it
    'will NOT work with older versions, since until version X a different shortcut was
    'used in order to show the crop window (CTRL + SHIFT + T).
    'For older Adobe Professional versions you can use the VBA code in the following link:
    'http://www.myengineeringworld.net/2012/09/export-excel-charts-as-tiff-images.html#more
    
    'NOTE: the macro does NOT work either with Acrobat Reader or with older versions of
    'Adobe Professional (prior to XI).
        
    'By Christos Samaras
    'Date: 28/6/2013
    'http://www.myengineeringworld.net
    '----------------------------------------------------------------------------------------------
        
    '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 StartTime           As Date
    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
    
    'Disable screen flickering.
    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 bellow uses the CropWindow macro in order to remove the white margin around the chart.
    'It calls the macro repeatedly until the page size becomes less than A4 size (in points),
    'which will imply that the page has been successfully cropped.
    If strChOrient = "1" Then
        StartTime = Now()
        Do Until Now() > StartTime + TimeValue("00:00:15")
            Call CropWindow(strPdfPath)
            Set objAcroPoint = objAcroPDPage.GetSize
            If objAcroPoint.x < 580 <> 0 Then Exit Do
        Loop
    Else
        StartTime = Now()
        Do Until Now() > StartTime + TimeValue("00:00:15")
            Call CropWindow(strPdfPath)
            Set objAcroPoint = objAcroPDPage.GetSize
            If objAcroPoint.y < 580 <> 0 Then Exit Do
        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

Spy++ Remove White Margin

The following VBA code is actually the "new" approach, using API functions. Again, the Spy++ was used in order to find the window sequence. The desired "remove white margin" checkbox was buried under 4 windows, as the above picture depicts. This is the reason why the majority of the code is dealing with the windows sequence.

Option Explicit

'The necessary API functions and constants that are used in this module.

'Retrieves a handle to the top-level window whose class name and window name match the specified strings.
'This function does not search child windows. This function does not perform a case-sensitive search.
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'Retrieves a handle to a window whose class name and window name match the specified strings.
'The function searches child windows, beginning with the one following the specified child window.
'This function does not perform a case-sensitive search.
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long

'Brings the thread that created the specified window into the foreground and activates the window.
'Keyboard input is directed to the window, and various visual cues are changed for the user.
'The system assigns a slightly higher priority to the thread that created the foreground
'window than it does to other threads.
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

'Suspends the execution of the current thread until the time-out interval elapses.
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'Sends the specified message to a window or windows. The SendMessage function calls the window procedure
'for the specified window and does not return until the window procedure has processed the message.
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

'Synthesizes a keystroke. The system can use such a synthesized keystroke to generate a WM_KEYUP or
'WM_KEYDOWN message. The keyboard driver's interrupt handler calls the keybd_event function.
Public Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

'Synthesizes mouse motion and button clicks.
Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, _
ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

'Constants used in API functions.
Public Const KEYEVENTF_KEYUP = &H2
Public Const BM_CLICK = &HF5&
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4

Sub CropWindow(PDFpath As String)

    '----------------------------------------------------------------------------------
    'This macro brings the Adobe Professional window to the foreground and then
    'a sequence of API functions is used in order to show the crop window (simulating
    'the key C + double mouse click shortcut), check the remove white margin checkbox
    'and press the OK button in order to crop the page.
   
    'By Christos Samaras
    'Date: 28/6/2013
    'http://www.myengineeringworld.net
    '----------------------------------------------------------------------------------
   
    'Declararing the necessary variables.
    Dim PDFName     As String
    Dim StartTime   As Date
    Dim lParent     As Long
    Dim Ret         As Long
    Dim ChildRet    As Long
    Dim ChildRet2   As Long
    Dim ChildRet3   As Long
    Dim ChildRet4   As Long
    Dim ChildOK     As Long
   
    'Get the filename from the full path.
    On Error Resume Next
    PDFName = Mid(PDFpath, WorksheetFunction.Find("*", WorksheetFunction.Substitute(PDFpath, "\", "*", Len(PDFpath) _
    - Len(WorksheetFunction.Substitute(PDFpath, "\", "")))) + 1, Len(PDFpath))
    On Error GoTo 0
                                       
    'Find the Adobe Professional window.
    StartTime = Now()
    Do Until Now() > StartTime + TimeValue("00:00:05")
        lParent = 0
        DoEvents
        lParent = FindWindow("AcrobatSDIWindow", PDFName & " - Adobe Acrobat Pro")
        If lParent <> 0 Then Exit Do
    Loop
   
    If lParent <> 0 Then
   
        'Bring the Adobe window on the top of other windows.
        Call SetForegroundWindow(lParent)
       
        'Pass the shortcut: key C + double mouse (left) click to the Adobe window.
        'This shortcut will bring up the crop window.
        StartTime = Now()
        Do Until Now() > StartTime + TimeValue("00:00:05")
            keybd_event vbKeyC, 0, 0, 0 'press C
            keybd_event vbKeyC, 0, KEYEVENTF_KEYUP, 0 ' release C
            Sleep 1000
            mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
            mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
            mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
            mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
            Ret = FindWindow(vbNullString, "Set Page Boxes")
            If Ret <> 0 Then Exit Do
        Loop

        'Find the first child window - GroupBox.
        If Ret <> 0 Then
            StartTime = Now()
            Do Until Now() > StartTime + TimeValue("00:00:05")
                ChildRet = 0
                DoEvents
                ChildRet = FindWindowEx(Ret, ByVal 0&, "GroupBox", vbNullString)
                If ChildRet <> 0 Then Exit Do
            Loop
           
            'Find the second child window - GroupBox.
            If ChildRet <> 0 Then
                StartTime = Now()
                Do Until Now() > StartTime + TimeValue("00:00:05")
                    ChildRet2 = 0
                    DoEvents
                    ChildRet2 = FindWindowEx(ChildRet, ByVal 0&, "GroupBox", vbNullString)
                    If ChildRet2 <> 0 Then Exit Do
                Loop
               
                'Find the third child window - GroupBox.
                If ChildRet2 <> 0 Then
                    StartTime = Now()
                    Do Until Now() > StartTime + TimeValue("00:00:05")
                        ChildRet3 = 0
                        DoEvents
                        ChildRet3 = FindWindowEx(ChildRet2, ByVal 0&, "GroupBox", vbNullString)
                        If ChildRet3 <> 0 Then Exit Do
                    Loop
   
                    'Find the remove white margin checkbox.
                    If ChildRet3 <> 0 Then
                        StartTime = Now()
                        Do Until Now() > StartTime + TimeValue("00:00:05")
                            ChildRet4 = 0
                            DoEvents
                            ChildRet4 = FindWindowEx(ChildRet3, ByVal 0&, vbNullString, "Remove &White Margins")
                            If ChildRet4 <> 0 Then Exit Do
                        Loop

                        'Check/uncheck the checkbox and press the OK button in crop window.
                        If ChildRet4 <> 0 Then
                           SendMessage ChildRet4, BM_CLICK, 0, 0
                           StartTime = Now()
                           Do Until Now() > StartTime + TimeValue("00:00:05")
                               ChildOK = 0
                               DoEvents
                               ChildOK = FindWindowEx(ChildRet, ByVal 0&, "Button", "OK")
                               If ChildOK <> 0 Then Exit Do
                           Loop
                            If ChildOK <> 0 Then
                                SendMessage ChildOK, BM_CLICK, 0, 0
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
End Sub

Finally, if you want to export all the charts from an Excel workbook you can use the macro below; it loops through all embedded charts and chart sheets and uses the ChartAsTiffNoMsg macro to convert the charts to PDFs and then to TIFF images. 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
    'Date: 28/6/2013
    'http://www.myengineeringworld.net
    '-----------------------------------------------------------------------------

    'Declararing the necessary variables.
    Dim objCh As Object
    Dim ws As Worksheet
    
    'Disable screen flickering.
    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
    
    'Enable the screen.
    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


Demonstration video

The short video below shows you how to enable the "single-key accelerator" option in Adobe Professional and demonstrates a sample case were 4 charts are being saved as TIFF images.



Final words

A small change in a newer version of a program sometimes can cause a lot of troubles. I read many complaints on the internet about this shortcut change. In my opinion, Adobe should listen and take into account the opinion from older users and try to keep its software as user-friendly as possible. Last but not least, I would like to thank Tammy for pointing out the problem with my older VBA code.


Download it from here

Download

The file can be opened with Excel 2007 or newer. Please enable macros before using it.


Read also

Export Excel Charts As TIFF images Using Adobe Professional

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