Unless otherwise specified, the macros below work in PowerPoint 2002

MS PowerPoint macro for calculating the total number of characters including spaces in a PowerPoint presentation

MS PowerPoint macro for calculating the total number of characters including spaces in a PowerPoint presentation

What the macro does

This macro calculates the total number of characters including spaces in the MS PowerPoint document that you need to translate and works out the cost of a translation and the time required to translate the document (based on 6000 characters in 8 h: these values may be changed to reflect your own personal output).

How to set up the macro

NOTE: Unlike MS Word, PowerPoint does not have a normal.dot into which you can save this macro to access the macro every time you open Powerpoint. Therefore you need to create a PowerPoint Add-In as described below:

IMPORTANT: For this macro to work, you need to set your security level in Powerpoint to Medium (recommended) or Low first. To do so, in Powerpoint select Tools/Macros/Security and unde Security Level select Medium or Low. Close down Powerpoint. When you open this document (from within PowerPoint, with File/Open ...), you will be asked whether you wish to enable the macros in the document: Reply Yes.

To install the macro, use either of the two following techniques:

A) Save this file => powerpoint_macros.ppt (by right-clicking on the link) to your hard disk and jump to point 10 below or
B) Follow the procedure below from point 1.

1. Start PowerPoint and create a blank presentation by clicking on the white-sheet icon at the top left of your screen.

2. On the Tools menu, select Macro and then Macros.

3. The Macro dialog box will open. Type the name "QuotePowerpoint" for the macro in the "Macro name:" field.

4. Click the Create button.

5. A window entitled "Microsoft Visual Basic" will open. In the window that appears, find the line of text that reads: Macro created [Today’s Date] by [Your Name]. The cursor should be blinking just before "End Sub".

6. Select and copy the text of the macro shown below by left-clicking at the beginning (including the initial apostrophe) and dragging your mouse down across the text. Make sure that you get it all, right up to the end, and that you copy only the material that appears between the lines of asterisks; DO NOT copy extra blank lines or the asterisks themselves.

**********cut here (do not include this line) **********

' Check to see whether a presentation is open.
If Presentations.Count <> 0 Then
Dim oSlide As Slide
Dim CharCount As Long

With ActivePresentation
' Iterate through each slide in the presentation
For Each oSlide In .Slides
'Count characters in the slide and the associated notes page
CharCount = CharCount + CountCharsOnSlide(oSlide)
CharCount = CharCount + CountCharsOnSlide(oSlide.NotesPage)
Next oSlide

'Count characters in the Masters
CharCount = CharCount + CountCharsOnSlide(.SlideMaster)
CharCount = CharCount + CountCharsOnSlide(.NotesMaster)
CharCount = CharCount + CountCharsOnSlide(.HandoutMaster)

If ActivePresentation.HasTitleMaster Then
CharCount = CharCount + CountCharsOnSlide(.TitleMaster)
End If

End With

Dim Message, Title, Myrate, Mychars, Mycost, Mytime, Sp, Myfilename
Err = 0
Myfilename = Application.ActivePresentation.Name
Message = "Enter your rate per line of 55 characters including spaces, e.g. 3.50"
Title = "Quote for translation job based on source text"
Myrate = InputBox(Message, Title)
On Error GoTo noinput

noinput:
If Err <> 0 Then
MsgBox "You need to enter your translation rate per line!"
Exit Sub
End If

Mycost = CharCount / 55 * Myrate
Mycost = Round(Mycost * 2, 1) / 2
Mytime = CharCount * 8 / 6000
Mytime = Round(Mytime, 1)
Sp = Chr(32)
MsgBox "Source text FILE NAME:" + Sp + "" + Sp + "" + Sp + "" + Sp + "" + Sp + "" + Sp + "" + Sp + "" + Sp + "" + Sp + "" + Sp + "" + Sp + "" + Sp + "" + Sp + "" + Sp + "" + Sp + "" + Myfilename + "" & vbCr & "Total CHARACTERS incl. spaces:" + Sp + "" + Sp + "" & CharCount & " char." & vbCr & "RATE per line of 55 characters:" + Sp + "" + Sp + "" + Sp + "" + Sp + "SFr." & Myrate & "" & vbCr & "COST of translating the text:" + Sp + "" + Sp + "" + Sp + "" + Sp + "" + Sp + "" + Sp + "" + Sp + "SFr." & Mycost & "" & vbCr & "TIME required (6000 char./8 h):" + Sp + "" + Sp + "" + Sp + "" & Mytime & " h" & vbCr & "" & vbCr & "For an updated version of this macro, visit WWW.MULTILINGUAL.CH", vbInformation + vbOKOnly

Else
MsgBox "No presentation open. Open a presentation and " _
& "run the macro again.", vbExclamation
End If
End Sub

' Note the declaration as Object instead of explicitly using Slide;
' since I am passing, slides, notes, Slide/Notes/Handouts master

Function CountCharsOnSlide(oSlide As Object) As Long
Dim oShape As Shape
Dim CharsOnSlide As Long
For Each oShape In oSlide.Shapes
' Check if the current shape has a text frame
If oShape.HasTextFrame Then
'Check if the text frame has text in it.
If oShape.TextFrame.HasText Then
' Increment character count
CharsOnSlide = CharsOnSlide + _
oShape.TextFrame.TextRange.Characters.Count
End If
End If
Next oShape
CountCharsOnSlide = CharsOnSlide
End Function

Sub Auto_Open()

Dim NewControl As CommandBarControl

' Store an object reference to a command bar.
Dim ToolsMenu As CommandBars

' Figure out where to place the menu choice.
Set ToolsMenu = Application.CommandBars

' Create the menu choice. The choice is created in the first
' position in the Tools menu.
Set NewControl = ToolsMenu("Tools").Controls.Add _
(Type:=msoControlButton, _
Before:=1)

' Name the command.
NewControl.Caption = "Translation quote for Powerpoint"

' Connect the menu choice to your macro. The OnAction property
' should be set to the name of your macro.
NewControl.OnAction = "QuotePowerpoint"
End Sub

Sub Auto_Close()

Dim oControl As CommandBarControl
Dim ToolsMenu As CommandBars

' Get an object reference to a command bar.
Set ToolsMenu = Application.CommandBars

' Loop through the commands on the tools menu.
For Each oControl In ToolsMenu("Tools").Controls

' Check to see whether the comand exists.
If oControl.Caption = "Translation quote for Powerpoint" Then

' Check to see whether action setting is set to QuotePowerpoint.
If oControl.OnAction = "QuotePowerpoint" Then

' Remove the command from the menu.
oControl.Delete
End If
End If
Next oControl

**********cut here (do not include this line) **********

NOTE: the text above marked in red may be changed to suit your specific needs.
 

7. Paste the macro lines that you copied in step 6 into the Visual Basic window at the spot where the input cursor is blinking.

8. Close the whole Visual Basic window (File/Close). Your macro is now installed in your blank presentation.

9. Save your blank presentation to your hard disk somewhere, calling it for example "powerpoint_macros.ppt", but do not close it yet.

10. Now create the ppa file (PowerPoint add-in)...

11. On the File menu in Powerpoint, click Save As.

12. In the Save As Type list, select PowerPoint Add-In (*.ppa) (Italian: componente aggiuntivo di Powerpoint).

13. In the File Name box, type a name for your add-in (e.g. "powerpoint_macros.ppa"), and then click Save. Typically, PowerPoint add-ins are placed in the c:\Program Files\ Microsoft Office\Office folder. However, you can choose another folder if you want.

14. To load the newly created add-in, in the Tools menu click Add-Ins; Click Add New; In the Add New PowerPoint Add-In dialog box, select the add-in file that you have just created and click OK. In the macro warning message box, click Enable Macros.

Your macros will now work every time you open Powerpoint.

How to run the macro

1. To run the macro, open a file in Powerpoint, and in the Tools menu click on Translation quote in Powerpoint.
 

NOTE: If you move your PowerPoint add-in file (.ppa) to a different location from where you saved it in step 13, you will need to repeat step 14 above. This macro will work as long as your ppa file is in the location specified during step 14.

Adding new macros to your PowerPoint add-in

If you wish to add new macros to the PowerPoint add-in that you have just created, add them by copying the code into the powerpoint_macros.ppt file as described above (steps 2 to 9, using the code for the new macros) and save the .ppt file; Exit PowerPoint; In Explorer (former File Manager), delete the .ppa file by the same name ("powerpoint_macros.ppa"); Open "powerpoint_macros.ppt" again, then carry out the procedure above from point 10 onwards.
 

more macros...

Once you have installed your macro, you will need to add a macro button in your toolbar or in your right-click menu to run the macro.