PPT常用宏代码

PPT中常用宏代码倒计时宏代码OptionExplicitPublicDeclareSubSleepLibkernel32(ByValdwMillisecondsAsLong)SubTmr()'Justintheeventualitythatyouclickthestartbuttontwice'isRunningstoresthecurrentstateofthemacro'TRUE=Running;FALSE=IdleStaticisRunningAsBooleanIfisRunning=TrueThenEndElseisRunning=TrueDimTMinusAsIntegerDimxtimeAsDatextime=Now'OnSlide1,Shape1isthetextboxWithActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange.Text=Ladies&Gentlemen.&vbCrLf&_Pleasebeseated.Weareabouttobegin.With.Shapes(1)'CountdowninsecondsTMinus=120DoWhile(TMinus-1)'Suspendprogramexecutionfor1second(1000milliseconds)Sleep1000xtime=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'Verycrucialelsethedisplaywon'trefreshitselfDoEventsLoopEndWith'3-2-1-0BlastoffandmovetothenextslideoranyslideforthatmatterSlideShowWindows(1).View.GotoSlide(2)isRunning=False.Shapes(2).TextFrame.TextRange.Text=ClickheretostartcountdownEndEndWithEndIfEndSub批量删除幻灯片备注之宏代码SubDeleteNote()DimactpptAsPresentationDimpptcountAsIntegerDimiChoseAsIntegerDimbDeleteAsBooleanDimsMsgBoxAsStringDimdirpathAsStringDimtxtstringAsStringsMsgBox=运行该宏之前，请先作好备份！继续吗？iChoice=MsgBox(sMsgBox,vbYesNo,备份提醒)IfiChoice=vbNoThenExitSubEndIfsMsgBox=导出备注后，需要删除PPT备注吗？iChoice=MsgBox(sMsgBox,vbYesNo,导出注释)IfiChoice=vbNoThenbDelete=FalseElsebDelete=TrueEndIfSetactppt=Application.ActivePresentationdirpath=actppt.Path&\&actppt.Name&的备注.txtpptcount=actppt.Slides.Count'打开书写文件Setfs=CreateObject(Scripting.FileSystemObject)Seta=fs.CreateTextFile(dirpath,True)'遍历pptWithactpptFori=1Topptcounttxtstring=.Slides(i).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.TextIf(bDelete)Then.Slides(i).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text=EndIfa.writeline(.Slides(i).SlideIndex)a.writeline(txtstring)a.writeline()NextiEndWitha.CloseEndSubUsingSetTimer/KillTimerAPIOptionExplicit'APIDeclarationsDeclareFunctionSetTimerLibuser32_(ByValhwndAsLong,_ByValnIDEventAsLong,_ByValuElapseAsLong,_ByVallpTimerFuncAsLong)AsLongDeclareFunctionKillTimerLibuser32_(ByValhwndAsLong,_ByValnIDEventAsLong)AsLong'PublicVariablesPublicSecondCtrAsIntegerPublicTimerIDAsLongPublicbTimerStateAsBooleanSubTimerOnOff()IfbTimerState=FalseThenTimerID=SetTimer(0,0,1000,AddressOfTimerProc)IfTimerID=0ThenMsgBoxUnabletocreatethetimer,vbCritical+vbOKOnly,ErrorExitSubEndIfbTimerState=TrueElseTimerID=KillTimer(0,TimerID)IfTimerID=0ThenMsgBoxUnabletostopthetimer,vbCritical+vbOKOnly,ErrorEndIfbTimerState=FalseEndIfEndSub'Thedefinedroutinegetscalledeverynnnnmilliseconds.SubTimerProc(ByValhwndAsLong,_ByValuMsgAsLong,_ByValidEventAsLong,_ByValdwTimeAsLong)SecondCtr=SecondCtr+1ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange.Text=CStr(SecondCtr)EndSub改变表格边框颜色及线条粗细之宏代码OptionExplicitSubHowToUseIt()CallSetTableBorder(ActivePresentation.Slides(1).Shapes(1).Table)EndSubSubSetTableBorder(oTableAsTable)DimIAsIntegerWithoTableForI=1To.Rows.CountWith.Rows(I).Cells(1).Borders(ppBorderLeft).ForeColor.RGB=RGB(255,153,51).Weight=10EndWithWith.Rows(I).Cells(.Rows(I).Cells.Count).Borders(ppBorderRight).ForeColor.RGB=RGB(255,153,51).Weight=10EndWithNextIForI=1To.Columns.CountWith.Columns(I).Cells(1).Borders(ppBorderTop).ForeColor.RGB=RGB(255,153,51).Weight=10EndWithWith.Columns(I).Cells(.Columns(I).Cells.Count).Borders(ppBorderBottom).ForeColor.RGB=RGB(255,153,51).Weight=10EndWithNextIEndWithEndSub删除所有隐藏幻灯片的宏代码SubDelHiddenSlide()DimsldAsSlide,shpAsShape,foundAsBooleanDofound=FalseForEachsldInActivePresentation.SlidesIfsld.SlideShowTransition.Hidden=msoTrueThenfound=Truesld.DeleteEndIfNextLoopWhilefound=TrueEndSubPPT自动生成大纲宏：DimstrFileNameAsString'BothI&JareusedascountersDimIAsIntegerDimJAsInteger'Workingontheactivepresentation.WithActivePresentation'Displaytheinputboxwiththedefault'Titles.Txt'strFileName=InputBox(Enterafilenametoexportslidetitles,Providefilename...,Titles.txt)'CheckiftheuserhaspressedCancel(Inputboxreturnsazerolengthstring)IfstrFileName=ThenExitSubEndIf'Dosomegoodhousekeepingandcheckfortheexistenceofthefile.'Asktheuserforfurtherdirectionsincaseitdoes.:)IfDir(.Path&\&strFileName)ThenIfMsgBox(strFileName&alreadyexists.Overwriteit?,_vbQuestion+vbYesNo,Warning)=vbNoThenExitSubEndIfEndIf'Openthefileforexportingtheslidetitles.Fileiscreatedinthesamefolderastheopenpresentation.'IfthePresentationisanewone(Nopath)thenitwillgetcreatedintheRootFolderOpen.Path&\&strFileNameForOutputAs#1ForI=1To.Slides.Count'ReturnsTRUEifthereisaTitlePlaceholderIf.Slides(I).Shapes.HasTitleThen'NowloopthruthePlaceHoldersandpickthetextfromtheTitlePlaceHolderForJ=1To.Slides(I).Shapes.Placeholders.CountWith.Slides(I).Shapes.Placeholders.Item(J)If.PlaceholderFormat.Type=ppPlaceholderTitleThen'Justinsertedfordebuggingpurposes...Debug.Print.TextFrame.TextRange'WritethetitletexttotheoutputfilePrint#1,.TextFrame.TextRangeEndIfEndWithNextJEndIfNextI'ClosetheopenfileClose#1EndWithEndSub