Microsoft KB Archive/202088: Difference between revisions
m (Text replacement - "<" to "<") |
m (Text replacement - """ to """) |
||
(2 intermediate revisions by the same user not shown) | |||
Line 80: | Line 80: | ||
<li>Create or open a presentation in PowerPoint.</li> | <li>Create or open a presentation in PowerPoint.</li> | ||
<li>On the '''Tools''' menu, point to '''Macro''', and then click '''Visual Basic Editor'''.</li> | <li>On the '''Tools''' menu, point to '''Macro''', and then click '''Visual Basic Editor'''.</li> | ||
<li>On the '''Insert''' menu, click '''Class Module'''. A module called | <li>On the '''Insert''' menu, click '''Class Module'''. A module called "Class1" will be inserted into your project.</li> | ||
<li><p>In the Class1 module window, type the following lines of code:</p> | <li><p>In the Class1 module window, type the following lines of code:</p> | ||
<pre class="codesample">Public WithEvents appEvent As Application | <pre class="codesample">Public WithEvents appEvent As Application | ||
Line 101: | Line 101: | ||
' | ' | ||
Module1.endShowCount | Module1.endShowCount | ||
presName = | presName = "" | ||
Else | Else | ||
' | ' | ||
Line 108: | Line 108: | ||
' desktop when this transition occurs. You can modify this subprocedure | ' desktop when this transition occurs. You can modify this subprocedure | ||
' by following the example in article Q222709 in the Microsoft Knowledge | ' by following the example in article Q222709 in the Microsoft Knowledge | ||
' Base. For more information, see the | ' Base. For more information, see the "References" section of this article. | ||
' | ' | ||
Presentations(presName).SlideShowWindow.Activate | Presentations(presName).SlideShowWindow.Activate | ||
Line 155: | Line 155: | ||
' the Tools menu. Set the caption and enable the button. | ' the Tools menu. Set the caption and enable the button. | ||
' | ' | ||
Set NewControl = ToolsMenu( | Set NewControl = ToolsMenu("Tools").Controls.Add(msoControlPopup) | ||
NewControl.Caption = | NewControl.Caption = "Slide Coutnters" | ||
NewControl.Enabled = True | NewControl.Enabled = True | ||
' | ' | ||
' Set the optional ToolTip text for the control. | ' Set the optional ToolTip text for the control. | ||
' | ' | ||
NewControl.TooltipText = | NewControl.TooltipText = "Adds Hit counters to your presentation." | ||
' | ' | ||
' Make the control visible. | ' Make the control visible. | ||
Line 174: | Line 174: | ||
Set menuControl = NewControl.CommandBar.Controls.Add(msoControlButton) | Set menuControl = NewControl.CommandBar.Controls.Add(msoControlButton) | ||
menuControl.Style = msoButtonCaption | menuControl.Style = msoButtonCaption | ||
menuControl.Caption = | menuControl.Caption = "Print Report" | ||
menuControl.Enabled = True | menuControl.Enabled = True | ||
menuControl.Visible = True | menuControl.Visible = True | ||
menuControl.OnAction = | menuControl.OnAction = "ReportHits" | ||
Set menuControl = Nothing | Set menuControl = Nothing | ||
' | ' | ||
Line 187: | Line 187: | ||
Set menuControl = NewControl.CommandBar.Controls.Add(msoControlButton) | Set menuControl = NewControl.CommandBar.Controls.Add(msoControlButton) | ||
menuControl.Style = msoButtonCaption | menuControl.Style = msoButtonCaption | ||
menuControl.Caption = | menuControl.Caption = "Reset Counters" | ||
menuControl.Enabled = True | menuControl.Enabled = True | ||
menuControl.Visible = True | menuControl.Visible = True | ||
menuControl.OnAction = | menuControl.OnAction = "ResetCount" | ||
Set menuControl = Nothing | Set menuControl = Nothing | ||
' | ' | ||
Line 200: | Line 200: | ||
Set menuControl = NewControl.CommandBar.Controls.Add(msoControlButton) | Set menuControl = NewControl.CommandBar.Controls.Add(msoControlButton) | ||
menuControl.Style = msoButtonCaption | menuControl.Style = msoButtonCaption | ||
menuControl.Caption = | menuControl.Caption = "Add Counter" | ||
menuControl.Enabled = True | menuControl.Enabled = True | ||
menuControl.Visible = True | menuControl.Visible = True | ||
menuControl.OnAction = | menuControl.OnAction = "SetupCounters" | ||
Set menuControl = Nothing | Set menuControl = Nothing | ||
' | ' | ||
Line 213: | Line 213: | ||
Set menuControl = NewControl.CommandBar.Controls.Add(msoControlButton) | Set menuControl = NewControl.CommandBar.Controls.Add(msoControlButton) | ||
menuControl.Style = msoButtonCaption | menuControl.Style = msoButtonCaption | ||
menuControl.Caption = | menuControl.Caption = "Run Show With Count" | ||
menuControl.Enabled = True | menuControl.Enabled = True | ||
menuControl.Visible = True | menuControl.Visible = True | ||
menuControl.OnAction = | menuControl.OnAction = "RunShowCount" | ||
Set menuControl = Nothing | Set menuControl = Nothing | ||
' | ' | ||
Line 236: | Line 236: | ||
' Loop through the commands on the Tools menu. | ' Loop through the commands on the Tools menu. | ||
' | ' | ||
For Each oControl In ToolsMenu( | For Each oControl In ToolsMenu("Tools").Controls | ||
' | ' | ||
' Check to see whether the command exists. | ' Check to see whether the command exists. | ||
' | ' | ||
If oControl.Caption = | If oControl.Caption = "Slide Coutnters" Then | ||
' | ' | ||
' Remove the command from the menu. | ' Remove the command from the menu. | ||
Line 262: | Line 262: | ||
' Check to see if a presentation is open. | ' Check to see if a presentation is open. | ||
' | ' | ||
If PowerPoint.Presentations.Count < | If PowerPoint.Presentations.Count <> 0 Then | ||
' | ' | ||
' Loop through the custom properties, setting the value for each | ' Loop through the custom properties, setting the value for each | ||
Line 286: | Line 286: | ||
' Test to ensure that there are shapes on the slide. | ' Test to ensure that there are shapes on the slide. | ||
' | ' | ||
If .Slides(i).Shapes.Count < | If .Slides(i).Shapes.Count <> 0 Then | ||
' | ' | ||
' If there are shapes on the slide, test to see if the first shape | ' If there are shapes on the slide, test to see if the first shape | ||
Line 295: | Line 295: | ||
' | ' | ||
If .Slides(i).Shapes(1).HasTextFrame Then | If .Slides(i).Shapes(1).HasTextFrame Then | ||
custName = custName & | custName = custName & ": " & _ | ||
.Slides(i).Shapes(1).TextFrame.TextRange.Text | .Slides(i).Shapes(1).TextFrame.TextRange.Text | ||
End If | End If | ||
Line 301: | Line 301: | ||
' | ' | ||
' Show a warning message. This will not halt the macro, but it will | ' Show a warning message. This will not halt the macro, but it will | ||
' remind the user to run | ' remind the user to run "Add Counters" again. | ||
' | ' | ||
' | ' | ||
MsgBox | MsgBox "The slide, " & custName & " has not been setup." _ | ||
& | & vbNewLine & _ | ||
"Please run Add Counter from the Slide Counters menu.", _ | |||
vbExclamation | vbExclamation | ||
Err.Clear | Err.Clear | ||
Line 315: | Line 315: | ||
' Display a confirmation message. | ' Display a confirmation message. | ||
' | ' | ||
MsgBox | MsgBox "The Counters have been reset.", vbExclamation | ||
Else | Else | ||
' | ' | ||
' If there are no presentations open, display this message: | ' If there are no presentations open, display this message: | ||
' | ' | ||
MsgBox | MsgBox "You do not have a presentation open!", vbExclamation | ||
End If | End If | ||
End Sub | End Sub | ||
Line 341: | Line 341: | ||
' Check to see if a presentation is open. | ' Check to see if a presentation is open. | ||
' | ' | ||
If PowerPoint.Presentations.Count < | If PowerPoint.Presentations.Count <> 0 Then | ||
' | ' | ||
' Loop through the presentation, creating a custom property for | ' Loop through the presentation, creating a custom property for | ||
Line 387: | Line 387: | ||
' Display a confirmation message. | ' Display a confirmation message. | ||
' | ' | ||
MsgBox | MsgBox "The counters for the presentation have been created and" & _ | ||
vbNewLine & | vbNewLine & "old counters have been removed." & vbNewLine & _ | ||
vbNewLine & | vbNewLine & "If you add or delete slides from this presentation," _ | ||
& | & vbNewLine & "run this command again to update the counters.", _ | ||
vbInformation | vbInformation | ||
Else | Else | ||
Line 396: | Line 396: | ||
' If there are no presentations open, display this message: | ' If there are no presentations open, display this message: | ||
' | ' | ||
MsgBox | MsgBox "You do not have a presentation open!", vbExclamation | ||
End If | End If | ||
End Sub | End Sub | ||
Line 412: | Line 412: | ||
' Check to see if a presentation is open. | ' Check to see if a presentation is open. | ||
' | ' | ||
If PowerPoint.Presentations.Count < | If PowerPoint.Presentations.Count <> 0 Then | ||
' | ' | ||
' Initialize strBase and lReport. The variable lreport is used | ' Initialize strBase and lReport. The variable lreport is used | ||
' to keep track of how many slides are created to print the report. | ' to keep track of how many slides are created to print the report. | ||
' | ' | ||
strBase = | strBase = "" | ||
lReport = 1 | lReport = 1 | ||
With ActivePresentation | With ActivePresentation | ||
Line 428: | Line 428: | ||
.Slides.Add lCount + lReport, ppLayoutTwoColumnText | .Slides.Add lCount + lReport, ppLayoutTwoColumnText | ||
.Slides(lCount + lReport).Shapes(1).TextFrame.TextRange.Text = _ | .Slides(lCount + lReport).Shapes(1).TextFrame.TextRange.Text = _ | ||
"Slide Hit Report" | |||
lColumn = 2 | lColumn = 2 | ||
' | ' | ||
Line 447: | Line 447: | ||
lHits = .CustomDocumentProperties(custName) | lHits = .CustomDocumentProperties(custName) | ||
If Err.Number = 5 Then | If Err.Number = 5 Then | ||
custName = | custName = "No counter for " & custName | ||
lHits = 0 | lHits = 0 | ||
Err.Clear | Err.Clear | ||
Line 455: | Line 455: | ||
' strBase. | ' strBase. | ||
' | ' | ||
strBase = strBase & | strBase = strBase & custName & ": " & Str(lHits) & vbCrLf | ||
' | ' | ||
' if i is evenly divisible by 28, the slide is full. Empty strBase | ' if i is evenly divisible by 28, the slide is full. Empty strBase | ||
Line 476: | Line 476: | ||
.Slides(lCount + _ | .Slides(lCount + _ | ||
lReport).Shapes(1).TextFrame.TextRange.Text = _ | lReport).Shapes(1).TextFrame.TextRange.Text = _ | ||
"Slide Hit Report Continued" | |||
' | ' | ||
' Set lColumn to the value 2. This is the shape index position of the first | ' Set lColumn to the value 2. This is the shape index position of the first | ||
Line 483: | Line 483: | ||
' | ' | ||
lColumn = 2 | lColumn = 2 | ||
strBase = | strBase = "" | ||
Else | Else | ||
' | ' | ||
Line 496: | Line 496: | ||
strBase | strBase | ||
lColumn = 3 | lColumn = 3 | ||
strBase = | strBase = "" | ||
End If | End If | ||
End If | End If | ||
Line 533: | Line 533: | ||
' If there are no presentations open, display this message: | ' If there are no presentations open, display this message: | ||
' | ' | ||
MsgBox | MsgBox "You do not have a presentation open!", vbExclamation | ||
End If | End If | ||
End Sub | End Sub |
Latest revision as of 12:48, 21 July 2020
Article ID: 202088
Article Last Modified on 10/11/2006
APPLIES TO
- Microsoft PowerPoint 2000 Standard Edition
This article was previously published under Q202088
SUMMARY
If you run a kiosk presentation that has many branches and choices that a person browsing it can make, it can be very useful to know which branches and slides have been visited the most and which have been visited the least.
This article contains sample Visual Basic for Applications code and implements an add-in that automates this process. It adds a menu item called Slide Counters to the Tools menu. The function of each counter is explained in the following table.
Counter Name Function ------------------------------------------------------------------------ Print Report Sends the finished report on counted slides to the printer. In the code sample, this is the only output produced by the add-in. No output will be displayed on the screen. Reset Counters Resets the existing counter applied to a slideshow. Add Counter Adds the counting functionallity to a presentation. Run Show with Count Runs the slideshow with the counter functionallity. This is the only way to run the show and keep a slide count.
MORE INFORMATION
Microsoft provides programming examples for illustration only, without warranty either expressed or implied. This includes, but is not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and with the tools that are used to create and to debug procedures. Microsoft support engineers can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific requirements. NOTE: The following macro examples work only in PowerPoint. Visual Basic for Applications macros are not supported by the Microsoft PowerPoint Viewer. For additional information, click the following article number to view the article in the Microsoft Knowledge Base:
Tracking Hits using Custom Properties
This add-in allows you to set up a presentation so that you can track how many times each slide has been visited, reset the counters, print a report with the slide hit counts, run the Slide Show, and track the hits on each slide.
NOTE: This add-in works only in PowerPoint 2000 or later. It is not meant to be used with web-based documents and does not run in PowerPoint Viewer.
Creating the Add-in
To create the add-in, follow these steps:
- Create or open a presentation in PowerPoint.
- On the Tools menu, point to Macro, and then click Visual Basic Editor.
- On the Insert menu, click Class Module. A module called "Class1" will be inserted into your project.
In the Class1 module window, type the following lines of code:
Public WithEvents appEvent As Application ' ' The public property presName is used to make sure that ' the counter is not turned off when a branched presentation ' ends. ' Public presName As String Private Sub appEvent_SlideShowEnd(ByVal Pres As Presentation) ' ' Check to make sure the starting presentation is the same ' as the presentation just ending. ' If Pres.Name = presName Then ' ' Call to Module1, invoking the sub procedure endShowCount, ' which turns off events. ' Module1.endShowCount presName = "" Else ' ' Restart the main slide show. Always end the branched show first ' before going on to another show. There will be a brief flicker on the ' desktop when this transition occurs. You can modify this subprocedure ' by following the example in article Q222709 in the Microsoft Knowledge ' Base. For more information, see the "References" section of this article. ' Presentations(presName).SlideShowWindow.Activate End If End Sub Private Sub appevent_SlideShowNextSlide(ByVal Wn As SlideShowWindow) ' ' Using On Error Resume Next allows this event handler to ignore ' presentations for which counters have not been enabled. ' On Error Resume Next Dim custName As String ' ' Get the name of the slide from the Wn object. ' custName = Wn.View.Slide.Name ' ' Increment the counter for the slide by one. ' ActivePresentation.CustomDocumentProperties(custName) = _ ActivePresentation.CustomDocumentProperties(custName) + 1 End Sub
- On the Insert menu, click Module.
Type the following Visual Basic for Applications code in the module:
Dim aEvent As New Class1 Sub Auto_Open() ' ' Define two comand bar controls, a pop-up menu and a command ' bar button. ' Dim NewControl As CommandBarPopup Dim menuControl As CommandBarButton ' ' Define an object reference to a command bar. ' Dim ToolsMenu As CommandBars ' ' Set the variable to the CommandBars object. ' Set ToolsMenu = Application.CommandBars ' ' Create the menu item. By default, it will be placed at the bottom of ' the Tools menu. Set the caption and enable the button. ' Set NewControl = ToolsMenu("Tools").Controls.Add(msoControlPopup) NewControl.Caption = "Slide Coutnters" NewControl.Enabled = True ' ' Set the optional ToolTip text for the control. ' NewControl.TooltipText = "Adds Hit counters to your presentation." ' ' Make the control visible. ' NewControl.Visible = True ' ' On the new pop-up menu create a new menu item. Set the style to ' caption, add the caption to the control, enable and make the control ' visible. Set the button to run the ReportHits subprocedure, and ' clear the button for the next control. ' Set menuControl = NewControl.CommandBar.Controls.Add(msoControlButton) menuControl.Style = msoButtonCaption menuControl.Caption = "Print Report" menuControl.Enabled = True menuControl.Visible = True menuControl.OnAction = "ReportHits" Set menuControl = Nothing ' ' On the new pop-up menu create a new menu item. Set the style to ' caption, add the caption to the control, enable and make the control ' visible. Set the button to run the ResetCount subprocedure, and ' clear the button for the next control. ' Set menuControl = NewControl.CommandBar.Controls.Add(msoControlButton) menuControl.Style = msoButtonCaption menuControl.Caption = "Reset Counters" menuControl.Enabled = True menuControl.Visible = True menuControl.OnAction = "ResetCount" Set menuControl = Nothing ' ' On the new pop-up menu create a new menu item. Set the style to ' caption, add the caption to the control, enable and make the control ' visible. Set the button to run the SetupCounters subprocedure, and ' clear the button for the next control. ' Set menuControl = NewControl.CommandBar.Controls.Add(msoControlButton) menuControl.Style = msoButtonCaption menuControl.Caption = "Add Counter" menuControl.Enabled = True menuControl.Visible = True menuControl.OnAction = "SetupCounters" Set menuControl = Nothing ' ' On the new pop-up menu create a new menu item. Set the style to ' caption, add the caption to the control, enable and make the control ' visible. Set the button to run the RunShowCount subprocedure, and ' clear the button for the next control. ' Set menuControl = NewControl.CommandBar.Controls.Add(msoControlButton) menuControl.Style = msoButtonCaption menuControl.Caption = "Run Show With Count" menuControl.Enabled = True menuControl.Visible = True menuControl.OnAction = "RunShowCount" Set menuControl = Nothing ' ' Clear the NewControl and ToolsMenu objects. ' Set NewControl = Nothing Set ToolsMenu = Nothing 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 command exists. ' If oControl.Caption = "Slide Coutnters" Then ' ' Remove the command from the menu. ' oControl.Delete End If Next oControl End Sub Sub ResetCount() ' ' Skip over slides that do have a counter assigned to them and ' continue resetting those that do. ' On Error Resume Next Dim i As Long Dim custName As String Dim errorTitle As String ' ' Check to see if a presentation is open. ' If PowerPoint.Presentations.Count <> 0 Then ' ' Loop through the custom properties, setting the value for each ' to zero. ' With ActivePresentation For i = 1 To .Slides.Count ' ' Set custName to the actual slide name. ' custName = .Slides(i).Name ' ' Set the custom property to 0. ' .CustomDocumentProperties(custName) = 0 ' ' Check to see if an error has occurred. This will happen if ' a new slide has been added to the presentation that has not been ' properly set up. ' If Err.Number = 5 Then ' ' Test to ensure that there are shapes on the slide. ' If .Slides(i).Shapes.Count <> 0 Then ' ' If there are shapes on the slide, test to see if the first shape ' has a text frame. This is usually the Title placeholder, though ' if you have added shapes and other objects to the slide and have ' sent them to the back, the object furthest back will be shape number ' one. If it does have text, add that text to custName. ' If .Slides(i).Shapes(1).HasTextFrame Then custName = custName & ": " & _ .Slides(i).Shapes(1).TextFrame.TextRange.Text End If End If ' ' Show a warning message. This will not halt the macro, but it will ' remind the user to run "Add Counters" again. ' ' MsgBox "The slide, " & custName & " has not been setup." _ & vbNewLine & _ "Please run Add Counter from the Slide Counters menu.", _ vbExclamation Err.Clear End If Next i End With ' ' Display a confirmation message. ' MsgBox "The Counters have been reset.", vbExclamation Else ' ' If there are no presentations open, display this message: ' MsgBox "You do not have a presentation open!", vbExclamation End If End Sub Sub SetupCounters() ' ' Test for existing custom document properties. If one exists, then no ' new property is created. If one doesn't, then a new property for ' that slide is created. ' ' Also, clear out counters for slides that no longer exist in the ' presentation. ' On Error Resume Next Dim i As Long Dim lDummy As Long Dim oDummySlide As Slide Dim strName As String ' ' Check to see if a presentation is open. ' If PowerPoint.Presentations.Count <> 0 Then ' ' Loop through the presentation, creating a custom property for ' each individual slide in the presentation. Name each ' property with the actual slide name. Unless you rename a slide ' via a macro, it will never change. ' With ActivePresentation For i = 1 To .Slides.Count ' ' Set strName equal to the current slide, then use that ' to set lDummy equal to the value in the custom properties. ' If there is no custom property that corresponds to the ' slide name, an error is displayed. ' strName = .Slides(i).Name lDummy = .CustomDocumentProperties(strName) If Err.Number = 5 Then ' ' Create the new custom property, set it to be a number and ' initialize to zero. Clear the error flag. ' .CustomDocumentProperties.Add Name:=strName, _ LinkToContent:=False, Type:=msoPropertyTypeFloat, Value:=0 Err.Clear End If Next i ' ' Loop through the custom properties and verify each one. ' For i = 1 To .CustomDocumentProperties.Count ' ' Set oDummySlide to the name in the custom properties to ' verify that a slide exists for the counter. If one does ' not, then the counter is deleted from the custom properties. ' Set oDummySlide = .Slides(.CustomDocumentProperties(i).Name) If Err.Number = -2147188160 Then .CustomDocumentProperties(i).Delete Err.Clear End If Next i End With ' ' Display a confirmation message. ' MsgBox "The counters for the presentation have been created and" & _ vbNewLine & "old counters have been removed." & vbNewLine & _ vbNewLine & "If you add or delete slides from this presentation," _ & vbNewLine & "run this command again to update the counters.", _ vbInformation Else ' ' If there are no presentations open, display this message: ' MsgBox "You do not have a presentation open!", vbExclamation End If End Sub Sub ReportHits() On Error Resume Next Dim i As Long Dim lCount As Long Dim lReport As Long Dim lColumn As Long Dim lHits As Long Dim strBase As String Dim custName As String ' ' Check to see if a presentation is open. ' If PowerPoint.Presentations.Count <> 0 Then ' ' Initialize strBase and lReport. The variable lreport is used ' to keep track of how many slides are created to print the report. ' strBase = "" lReport = 1 With ActivePresentation ' ' Set lCount to the number of slides in the presentation. ' Next create a new slide at the end of the presentation using the ' two column layout. Add a title, and set lColumn to 2. ' lCount = .Slides.Count .Slides.Add lCount + lReport, ppLayoutTwoColumnText .Slides(lCount + lReport).Shapes(1).TextFrame.TextRange.Text = _ "Slide Hit Report" lColumn = 2 ' ' Loop through the presentation, and build the text string that gets ' put into a text frame, create new slides when the frame gets full, ' print the report slides, and then delete them. ' For i = 1 To lCount ' ' Set custName to the current slide name. ' custName = .Slides(i).Name ' ' Using custName, set lHits to the value stored in the custom ' property. If the property does not exist, set custName to ' a short message and lHits to 0. ' lHits = .CustomDocumentProperties(custName) If Err.Number = 5 Then custName = "No counter for " & custName lHits = 0 Err.Clear End If ' ' Append the slide name and the hits for that slide to ' strBase. ' strBase = strBase & custName & ": " & Str(lHits) & vbCrLf ' ' if i is evenly divisible by 28, the slide is full. Empty strBase ' into the second column. Create a new slide, set the title. ' If i Mod 28 = 0 Then ' ' Set the second column of the Two Column layout slide to the contents ' of srtBase. The variable lColumn is the shape index position for the ' second column. ' .Slides(lCount + _ lReport).Shapes(lColumn).TextFrame.TextRange.Text = strBase ' ' Increment lReport, so that the full range of new slides can be ' printed out. ' lReport = lReport + 1 .Slides.Add lCount + lReport, ppLayoutTwoColumnText .Slides(lCount + _ lReport).Shapes(1).TextFrame.TextRange.Text = _ "Slide Hit Report Continued" ' ' Set lColumn to the value 2. This is the shape index position of the first ' column of the Two Column slide layout. Clear strBase for the next ' column's worth of text. ' lColumn = 2 strBase = "" Else ' ' If i is evenly divisble by 14, then there is enough text for ' the first column. Empty strBase into the first column, then ' set lColumn to the index position of the second column on the ' slide and clear srtBase. ' If i Mod 14 = 0 Then .Slides(lCount + _ lReport).Shapes(lColumn).TextFrame.TextRange.Text = _ strBase lColumn = 3 strBase = "" End If End If Next i ' ' When the last slide in the presentation is handled, empty strBase ' into the appropriate column on the last slide of the report. ' .Slides(lCount + _ lReport).Shapes(lColumn).TextFrame.TextRange.Text = strBase ' ' Print out the report slides, from the first report slide to the ' last report slide in Pure Black and White mode. ' With .PrintOptions .RangeType = ppPrintSlideRange .Ranges.ClearAll .Ranges.Add lCount + 1, lCount + lReport .PrintColorType = ppPrintPureBlackAndWhite End With ' ' Print the range of slides, then clear the print range. ' .PrintOut .PrintOptions.Ranges.ClearAll ' ' Loop through the last slides of the presentation, starting from ' the last slide and work backwards, deleting each slide as it goes. ' For i = lReport To 1 Step -1 .Slides(lCount + i).Delete Next i End With Else ' ' If there are no presentations open, display this message: ' MsgBox "You do not have a presentation open!", vbExclamation End If End Sub Sub RunShowCount() ' ' Set the class module property presName to the active presentation, ' start event handling, and finally run the show. ' aEvent.presName = ActivePresentation.Name Set aEvent.appEvent = Application ActivePresentation.SlideShowSettings.Run End Sub Sub endShowCount() ' ' Turn off event handling. ' Set aEvent.appEvent = Nothing End Sub
- On the Debug menu, click Compile VBAProject.
- On the File menu, click Close and Return to Microsoft PowerPoint.
- On the File menu, click Save As, name the file SlideCount.ppt and click Save.
- On the File menu, click Save As. In the Save File as Type list, click PowerPoint Add-In (.ppa) and then click Save.
- On the File menu, click Close.
Making the add-in available in PowerPoint
- On the Tools menu, click Add-Ins.
- Click Add New.
- Click SlideCount.ppa, and then click OK.
The Slide Counters add-in should now be available on the Tools menu in PowerPoint.
REFERENCES
For additional information about Visual Basic for Applications, click the article number below to view the article in the Microsoft Knowledge Base:
226118 OFF2000: Programming Resources for Visual Basic for Applications
For additional information about how to prevent PowerPoint from redrawing its screen, click the article number below to view the article in the Microsoft Knowledge Base:
222709 PPT2000: Sample Visual Basic Code to Control Window Redraw
Additional query words: kbmacro vba powerpnt powerpoint2000 2000 ppt2000 9.0 ppt9 powerpnt9
Keywords: kbdtacode kbhowto kbinfo KB202088