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:
a. Open Adobe Professional and go to menu Edit → Preferences.
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.
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 FilesAdobeAcrobat xx.0Acrobatacrobat.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:
'https://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
'https://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
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
'https://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
'https://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
The file can be opened with Excel 2007 or newer. Please enable macros before using it.
Read also
