ppt实用宏.docVIP

ppt实用宏 倒计时宏代码 Option Explicit Public Declare Sub Sleep Lib kernel32 (ByVal dwMilliseconds As Long) Sub Tmr() Just in the eventuality that you click the start button twice isRunning stores the current state of the macro TRUE = Running; FALSE = Idle Static isRunning As Boolean If isRunning = True Then End Else isRunning = True Dim TMinus As Integer Dim xtime As Date xtime = Now On Slide 1, Shape 1 is the textbox With ActivePresentation.Slides(1) .Shapes(2).TextFrame.TextRange.Text = Ladies Gentlemen. vbCrLf _ Please be seated. We are about to begin. With .Shapes(1) Countdown in seconds TMinus = 120 Do While (TMinus -1) Suspend program execution for 1 second (1000 milliseconds) Sleep 1000 xtime = Now .TextFrame.TextRange.Text = Format(TimeValue(Format(Now, hh:mm:ss)) - _ TimeSerial(Hour(Now), Minute(Now), Second(Now) + TMinus), hh:mm:ss) TMinus = TMinus - 1 Very crucial else the display wont refresh itself DoEvents Loop End With 3-2-1-0 Blast off and move to the next slide or any slide for that matter SlideShowWindows(1).View.GotoSlide (2) isRunning = False .Shapes(2).TextFrame.TextRange.Text = Click here to start countdown End End With End If End Sub 批量删除幻灯片备注之宏代码 Sub DeleteNote() Dim actppt As Presentation Dim pptcount As Integer Dim iChose As Integer Dim bDelete As Boolean Dim sMsgBox As String Dim dirpath As String Dim txtstring As String sMsgBox = 运行该宏之前，请先作好备份！继续吗？ iChoice = MsgBox(sMsgBox, vbYesNo, 备份提醒) If iChoice = vbNo Then Exit Sub End If sMsgBox = 导出备注后，需要删除PPT备注吗？ iChoice = MsgBox(sMsgBox, vbYesNo, 导出注释) If iChoice = vbNo Then bDelete = False Else bDelete = True End If Set actppt = Application.ActivePresentation dirpath = actppt.Path \ actppt.Name 的备注.txt pptcount = actppt.Slides.Count 打开书写文件 Set fs = CreateObject(Scripting.FileSystemObject) Set a = fs.CreateTextFile(dirpath, True) 遍历ppt With actppt For i = 1 To pptcount txtstring = .Slides(i).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text If (bDelete) Then .Slides(i).NotesPage.Shape