ppt宏怎么写( 三 ) _ppt

<> "\" Then Path = Path & "\" FileName = Dir(Path & Mask) On Error Resume Next Err.Clear Do Until FileName = "" DoEvents Set CurPresentation = Presentations.Open(FileName:=Path & FileName, ReadOnly:=msoFalse, WithWindow:=msoFalse) For Each oSld In CurPresentation.Slides For Each oShp In oSld.Shapes Err.Clear Set oTxtRng = oShp.TextFrame.TextRange If Err.Number = 0 Then Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _ Replacewhat:=ReplaceString, MatchCase:=False, _ WholeWords:=True) If oTmpRng Is Nothing Then oTxtRng = Replace(oTxtRng, FindString, ReplaceString, , , vbTextCompare)'解决中文无法替换问题（下同） Do While Not oTmpRng Is Nothing FindCount = FindCount + 1 Set oTxtRng = oTxtRng.Characters(oTmpRng.Start + oTmpRng.Length, _ oTxtRng.Length) Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _ Replacewhat:=ReplaceString, MatchCase:=False, _ WholeWords:=True) If oTmpRng Is Nothing Then oTxtRng = Replace(oTxtRng, FindString, ReplaceString, , , vbTextCompare) Loop End If Next oShp Next oSld CurPresentation.Save CurPresentation.Close FileName = Dir Loop MsgBox "替换完毕！" CloseEnd Sub 。
5.求写PPT宏代码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:s
【ppt宏怎么写】

文章插图