Home	Excel	Access
\| 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 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.

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 is 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, 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.

file: XLPresentation.htm

Page updated Oct17

CMIDX S5 P21 N