MeadInKent
| Feedback | Excel and Powerpoint |

Making a printed slide presentation with Excel

Excel can be used to prepare various tables and charts which are the content of a published presentation. The charts and worksheet ranges containing tables can be Paste Linked to a Powerpoint presentation so that they automatically update to reflect the latest Excel values. This largely automates the production and is useful when the same data is regularly exported to create a series of slides.

Excel and Powerpoint can be combined to create attractive documents with a common theme, but there are some potential problems. Minor changes to the source Excel data can affect the linked ranges and result in unintentional mistakes in the report which can easily go unnoticed. Also, using two separate programs complicates the production process.

Try doing it all in one place and publish a presentation using Excel

A particular challenge when using Excel to create a similar presentation is how to produce a common visual theme with decorated headers and footers. Excel won't allow background colours or combinations of text and pictures within Header and Footer sections. It does allow you to insert pictures into parts of the header and footer, but these won't dynamically update to contain information relating to each page.

A footer including images and descriptive text

It is possible to mimic headers and footers using cell formatting or shapes within the worksheet print area, but these may change size on different slides, particularly if Print Scaling is used to make tables fit a paper size. This looks poor. Excel Headers and Footers can remain a constant size, regardless of the Print Scaling of the page content.

Text shapes and images inserted into Excel headers and footers

A solution is to use Visual Basic (within Excel) to save image files (created from Excel Shapes) containing a combination of the required text and any pictures or shading to be used in the Excel header or footer. Macros can also load and resize the images into each custom header and footer.

Step One

If you are producing a series of slides based on separate worksheets, it may be useful to place a common table of Header and Footer design details on each worksheet.

A table containing header and footer elements

In this example the table contains the name of the Right Header image file (N1); the text title for the Left Header (N2); a slide page number (N3); the worksheet Shape object Name for the Centre Footer (N4); the filename to be used when the Shape is saved as an image (O4); the footer image width, height and scaling (O3, P3, P4); a text label to be added to the footer image, containing values such as the slide number (N3), the period number (N5) and any other common narrative (O5); the location of the image files.

Step Two

Create an Excel drawing shape (probably a Rectangle) containing the required images and also any footer text. You can either format it using Excel's colours and shading patterns, or use your own Picture file as a shape background image (Format Picture | Fill | Picture or Texture Fill | File ...). To add a dynamic text label to the shape, select the shape; click in the Formula Bar, type '=' and click on the worksheet cell containing the text (O5).

[O5] = "Performance Report [M" & TEXT(N5,"00") & "]. Slide: " & TEXT(N3,"0") & ", Published: " & TEXT(NOW(),"dd mmm yy")

The text label can be positioned within the shape by selecting Format Shape | Text Box and then amending the Internal Margins. The completed Shape can positioned anywhere on a worksheet and can then be copied and re-used on other worksheets.

Step Three

In order to save the Excel Shape as an image file, a visual basic program can copy the Shape to a Chart Object and save the object as a picture file.

Some trial and error testing is going to be required to find the best sizes to save the image files and to load them into the Footer Picture.  The image quality appears to be better by saving the object as a picture close to the size of the original shape. It can then be loaded into the header / footer and its display size adjusted using the percent value in cell P4.

It is possible to put separate pictures in different sections of the header or footer - i.e Left, Center, Right. If these are being used to provide a constant band of back colouring, it can be difficult to ensure that they all appear with identical height sizing, and the joins between each image might be visible.


Sub SaveShapeImages()
' Save shapes from the current worksheet as image files
' New images are inserted into custom Headers and Footers


Dim ChtName As String, ImgFileName As String, DataCol As Integer
Dim MyShapeName As String, MyH As Single, MyW As Single

If CheckShapesExist() = 1 Then Exit Sub

Debug.Print Time(), "Starting: SaveShapeImages()", "Sheet: " & ActiveSheet.Name
DataCol = Range("A5").Value  ' a value representing a column number which is the start position of my table containing details of the header and footer contents i.e. 13 = M
MyW = Round(Cells(3, DataCol + 2).Value * Cells(4, DataCol + 3).Value, 1)
MyH = Round(Cells(3, DataCol + 3).Value * Cells(4, DataCol + 3).Value, 1)

ImgFileName = Cells(6, DataCol + 1).Value & "\" & Cells(4, DataCol + 2).Value
MyShapeName = Cells(4, DataCol + 1).Value

ActiveSheet.Shapes(MyShapeName).CopyPicture
Set objChart1 = ActiveSheet.ChartObjects.Add(200, 200, MyW, MyH)
objChart1.Activate
ChtName = objChart1.Name
ActiveSheet.Shapes(ChtName).Line.Visible = msoFalse

ActiveChart.Paste
ActiveChart.Export FileName:=ImgFileName, FilterName:="GIF"
objChart1.Delete
Set objChart1 = Nothing

Debug.Print "SaveShapeImages() > "; Cells(4, DataCol).Value, MyShapeName & " saved as " & ImgFileName
Debug.Print "Size: " & MyW & " x " & MyH
Debug.Print Time(), "Finished: SaveShapeImages()"
End Sub

Sub MiK_SaveShapeImage()
' Save a Shape from the current worksheet as an image file

Dim ChtName As String, ImgFileName As String
Dim MyShapeName As String, MyH As Single, MyW As Single

MyW = Round(Range("O3").Value, 1)
MyH = Round(Range("P3").Value, 1)

ImgFileName = Range("N6").Value & "\" & Range("O4").Value
MyShapeName = Range("N4").Value

ActiveSheet.Shapes(MyShapeName).CopyPicture
Set objChart1 = ActiveSheet.ChartObjects.Add(200, 200, MyW, MyH)
objChart1.Activate
ChtName = objChart1.Name
ActiveSheet.Shapes(ChtName).Line.Visible = msoFalse

ActiveChart.Paste
ActiveChart.Export FileName:=ImgFileName, FilterName:="PNG"
objChart1.Delete
Set objChart1 = Nothing

Debug.Print Time(), "Image created on sheet " & ActiveSheet.Name
End Sub

Sub MiK_InsertImages()
' Items are inserted into custom Headers and Footers

Dim ImgFileName(4) As String, Img_Location As String
Dim MyH As Single, MyW As Single

MyW = Round(Range("O3").Value * Range("P4").Value, 1)
MyH = Round(Range("P3").Value * Range("P4").Value, 1)
Img_Location = Range("N6").Value

' ImgFileName(1) is not defined - I am using a text entry
ImgFileName(2) = Img_Location & "\" & Range("N1").Value
ImgFileName(3) = Img_Location & "\" & Range("O4").Value
' ImgFileName(4) is not defined - I am using a single footer image

' text is inserted into Left Header
ActiveSheet.PageSetup.LeftHeader = "&B&20&K0070C0" & Range("N2").Value

' a standard logo image is inserted into Right Header
ActiveSheet.PageSetup.RightHeaderPicture.FileName = ImgFileName(2)
ActiveSheet.PageSetup.RightHeader = "&G"

' a locally created image is inserted into Centre Footer
ActiveSheet.PageSetup.CenterFooterPicture.FileName = ImgFileName(3)

With ActiveSheet.PageSetup.CenterFooterPicture
.Height = MyH
.Width = MyW
End With

ActiveSheet.PageSetup.CenterFooter = "&G"

Debug.Print Time(), "Images inserted in sheet " & ActiveSheet.Name & " Size: " & MyW & " x " & MyH
End Sub


Function CheckShapesExist() As Byte
' Check whether the specified shapes exist
On Error GoTo MyErrorBit
Dim DataCol As Integer, MyShapeName As String

CheckShapesExist = 0
Debug.Print Time(), "CheckShapesExist()", "Sheet: " & ActiveSheet.Name
DataCol = Range("A5").Value

MyShapeName = Cells(4, DataCol + 1).Value
ActiveSheet.Shapes(MyShapeName).Select
Debug.Print "Fn CheckShapesExist() > " & MyShapeName & " exists (for " & Cells(4, DataCol).Value & ")"
Exit Function

MyErrorBit:
Debug.Print "Error - " & MyShapeName, Err.Description, Err.Number
MsgBox MyShapeName & " does not exist.", vbOKOnly, "ERROR - Program Stopped"
CheckShapesExist = 1
End Function

Function DoesFileExist(FileName As String) As Byte
' returns 1 if disk FileName exists, otherwise 0
If Dir(FileName, vbNormal) <> "" Then
 DoesFileExist = 1
Else
 DoesFileExist = 0
End If
End Function

List of Worksheets for PDF Output

Print a sequence of pages as a PDF presentation document

A simple program can be created to read a list of worksheet names and then output / print them into a single PDF file. You must have already defined the print areas on each of the sheets.

Sub MiK_MyPrintSheets()
Dim SheetArray() As String, NumPages As Integer, FirstRow As Integer
Dim n As Integer, MyCount As Integer, PDFname As String

PDFname = "C:\Users\Chris\Documents\MakePresentation2_Publish.pdf"

FirstRow = 10
NumPages = 4
ReDim SheetArray(1 To NumPages)

For n = FirstRow To FirstRow + NumPages - 1 ' put each of the worksheet names in an array
MyCount = MyCount + 1
SheetArray(MyCount) = Cells(n, 3).Value
Next n

Sheets(SheetArray).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
PDFname, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("Main").Select
Range("E1") = PDFname
Debug.Print NumPages; " pages saved as "; PDFname
MsgBox NumPages & " pages exported to PDF", vbOKOnly, "MiK_MyPrintSheets()"
End Sub

Get details of the print area and page scaling settings

Excel uses pixels as it's unit of measurement for the VBA settings. This can be inconvenient and I am not aware of a simple way to convert the values to something recognisable (such as mm). Through trial and error I have determined what I believe to the setting for an A4 page (At 100% zoom an A4 page will be approx 710 x 480px.) This may be a mistaken interpretation of my own PC display settings. This conversion however forms the basis of the following program. It places text in a specified cell, describing the print area settings and an estimate of the required zoom to make it fit on a single page.

Sub RangeDef(MyCell As String)
' calculate print scaling details for current sheet and enter them in specified MyCell

Dim MySheet As String, MyPrintArea As String, MyZoom As Single, MyTopShapeHeight As Single
Dim MyWidth As Single, MyHeight As Single, MyRatio As String, MyStr As String, TSName As String
Dim MyStr2 As String, MyHP As Single, MyWP As Single

MySheet = ActiveSheet.Name
MyPrintArea = Worksheets(MySheet).PageSetup.PrintArea
If MyPrintArea = "" Then
MyStr = "Sheet: [" & MySheet & "] Print area: Not Set"
MyStr2 = ""
Else
MyWidth = Worksheets(MySheet).Range(MyPrintArea).Width
MyHeight = Worksheets(MySheet).Range(MyPrintArea).Height
MyRatio = "(1.0 : " & Format(MyHeight / MyWidth, "0.00") & ")"
MyZoom = Worksheets(MySheet).PageSetup.Zoom
MyStr = "Sheet [" & MySheet & "] Print area " & MyPrintArea & " Zoom " & Format(MyZoom, "0") & "% Width " & Format(MyWidth, "0") & "px Height " & Format(MyHeight, "0") & "px " & MyRatio
MyHP = 480 / MyHeight
MyWP = 710 / MyWidth

If MyHP < MyWP Then MyWP = MyHP

MyStr2 = "An approximate resize for full page printing would be " & Format(MyWP, "0%")
MsgBox MyStr2, vbOKOnly + vbInformation, "RangeDef()"
End If

Debug.Print MyStr
Worksheets(MySheet).Range(MyCell) = MyStr

End Sub

Get this website as a document
accompanied by Excel worksheets
PDF Click here for details about obtaining this file.
This page is not included in the current edition.

file: XLPresentation.htm meadinkent.co.uk 2017 Page updated Mar17 CMIDX S5 P21 N