' ' Copyright 2007,2008 Abhijit P. Pai ' ' This program is free software: you can redistribute it and/or modify ' it under the terms of the GNU General Public License as published by ' the Free Software Foundation, either version 3 of the License, or ' (at your option) any later version. ' ' This program is distributed in the hope that it will be useful, ' but WITHOUT ANY WARRANTY; without even the implied warranty of ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ' GNU General Public License for more details. ' ' You should have received a copy of the GNU General Public License ' along with this program. If not, see . ' 'User-settable constants '~725 * ~540 seems to be the max x and y 'startx and starty are the starting x and y locations of the textbox 'showing the slide number ' ' 原文は以下のサイトです。 ' http://abhijitpai.blogspot.com/2007/12/auto-slide-numbering-in-ms-powerpoint.html ' ' 2009/8/28 若干パラメータを修正しました。 ' http://ryouchi.seesaa.net/ ' Const startx = 675# Const starty = 525# Const mywidth = 50# Const myheight = 30# Const myfontname = "Arial" Const myfontsize = 8 Const starttext = " " Const midtext = " / " 'set this to True if you want to remove the old numbering before you add the new one, else False Const RemoveBeforePutting = True 'End User-settable constants '------------------------------------------------------------- Sub PutSlideNos() If RemoveBeforePutting = True Then Call RemoveSlideNos 'total number of slides a = ActiveWindow.Presentation.Slides.Count 'total number of hidden slides b = 0 For i = 1 To ActiveWindow.Presentation.Slides.Count If ActivePresentation.Slides(i).SlideShowTransition.Hidden = -1 Then b = b + 1 Next i nonhidden = a - b j = 0 For i = 1 To ActiveWindow.Presentation.Slides.Count ActiveWindow.Presentation.Slides(i).Select j = j + 1 '-1 means true for this property If ActivePresentation.Slides(i).SlideShowTransition.Hidden = -1 Then j = j - 1 GoTo nexttry End If ActiveWindow.Selection.SlideRange.Shapes.AddTextbox(msoTextOrientationHorizontal, startx, starty, mywidth, myheight).Select ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select ActiveWindow.Selection.TextRange.Text = starttext + Trim(Str(j)) + midtext + Trim(Str(nonhidden)) With ActiveWindow.Selection.TextRange.Font .Name = myfontname .Size = myfontsize End With nexttry: Next i ActiveWindow.Presentation.Slides(1).Select End Sub Sub RemoveSlideNos() For i = 1 To ActiveWindow.Presentation.Slides.Count ActiveWindow.Presentation.Slides(i).Select j = 1 While j If ActiveWindow.Presentation.Slides(i).Shapes(j).TextFrame.HasText Then t = ActiveWindow.Presentation.Slides(i).Shapes(j).TextFrame.TextRange.Characters.Text If t Like starttext + "[0-9]*" + midtext + "[0-9]*" Then ActiveWindow.Presentation.Slides.Item(i).Shapes.Item(j).Delete End If End If j = j + 1 thecount = ActiveWindow.Presentation.Slides.Item(i).Shapes.Count If j > thecount Then GoTo endwhile Wend endwhile: Next i ActiveWindow.Presentation.Slides(1).Select End Sub