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 FilesAdobeAcrobat xx.0Acrobatacrobat.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
I just sent you an email.
However, in case someone has similar problem the solution is probably the following add-in:
http://www.microsoft.com/en-us/download/details.aspx?id=9943
Kind Regards,
Christos
First of all, thanks for this useful tool. However, an error occurred when I used this tool even I install Adobe Acrobat XI Professional. The error message is: Run-time error '5': Invalid procedure call or argument,
at:
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strChFullName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Please help me to solve the problem. My email is: [email protected]