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 go unnoticed.
- Changing the name of your source Excel file means that all of the paste links
need to be rebuilt.
- 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 titles and text information relating to each page.
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.
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 is useful to place a common table
of Header and Footer design details on each worksheet.
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, the period number 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 (at the top of the
screen), 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
be placed 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. (Creating a chart object may seem peculiar
but that is how Excel saves pictures, regardless of whether it actually contains
a real chart.)
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 with a size
similar to 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
single band of 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
|

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 some (text) information 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 |
 |
Click here for details about obtaining this file.
This page is not included in the current edition. |