九色国产,午夜在线视频,新黄色网址,九九色综合,天天做夜夜做久久做狠狠,天天躁夜夜躁狠狠躁2021a,久久不卡一区二区三区

打開APP
userphoto
未登錄

開通VIP,暢享免費電子書等14項超值服

開通VIP
Powerpoint中VBA編程技巧
.Application 對象 
該對象代表 PowerPoint 應用程序,通過該對象可訪問 PowerPoint 中的其他所有對象。 
 
(1)Active 屬性:返回指定窗格是否被激活。 
 
(2)ActivePresentation 屬性:返回 Presentation 對象,代表活動窗口中打開的演示文稿。 
 
(3)ActiveWindow 屬性:返回 DocumentWindow 對象,代表當前文檔窗口。 
 
(4)Presentations 屬性:返回 Presentations 集合,代表所有打開的演示文稿。 
 
(5)SlideShowWindows 屬性:返回 SlideShowWindows 集合,代表所有打開的幻燈片放映窗
口。 
 
(6)Quit 方法:用于退出 PowerPoint 程序。 
 
2.DocumentWindow 對象 
 
該對象代表文檔窗口。使用“Windows(index) ”語法可返回 DocumentWindow 對象。 
 
(1)ActivePane 屬性:返回 Pane 對象,代表文檔窗口中的活動窗格。 
 
(2)Panes 屬性:返回 Panes 集合,代表文檔窗口中的所有窗格。 
 
(3)ViewType 屬性:返回指定的文檔窗口內的視圖類型。[NextPage] 
 
3.Presentation 對象 
 
該對象代表演示文稿,通過“Presentations(index)”語法可返回 Presentation 對象。 
 
(1)BuiltInDocumentProperties 屬性:返回 DocumentProperties 集合,代表演示文稿的所有文
檔屬性。 
 
(2)ColorSchemes 屬性:返回 ColorSchemes 集合,代表演示文稿的配色方案。 
 
(3)PageSetup 屬性:返回 PageSetup 對象,用于控制演示文稿的幻燈片頁面設置屬性。 
 
(4)SlideMaster 屬性:返回幻燈片母版對象。 
 
(5)SlideShowSettings 屬性:返回 SlideShowSettings 對象,代表演示文稿的幻燈片放映設置。  
 
(6)SlideShowWindow 屬性:返回幻燈片放映窗口對象。 
 
(7)AddTitleMaster 方法:為演示文稿添加標題母版。 
 
 
 
(8)ApplyTemplate 方法:對演示文稿應用設計模板。 
 
4.SlideShowWindow 對象 
 
該對象代表幻燈片放映窗口。 
 
IsFullScreen 屬性:用于設置是否全屏顯示幻燈片放映窗口。[NextPage] 
 
5.Master 對象 
 
該對象代表幻燈片母版、標題母版、講義母版或備注母版。 
 
TextStyles 屬性:為幻燈片母版返回 TextStyles 集合,代表標題文本、正文文本和默認文本。  
 
6.Slide 對象 
 
該對象代表幻燈片。 
 
(1)SlideID 屬性:返回幻燈片的唯一標識符。 
 
(2)SlideIndex 屬性:返回幻燈片在 Slides 集合中的索引號。 
 
7.SlideShowView 對象 
 
該對象代表幻燈片放映窗口中的視圖。 
 
(1)AcceleratorsEnabled 屬性:用于設置是否允許在幻燈片放映時使用快捷鍵。 
 
(2)CurrentShowPosition 屬性:返回當前幻燈片在放映中的位置。 
 
(3)DrawLine 方法:在指定幻燈片放映視圖中繪制直線。 
 
(4)EraseDrawing 方法:用于清除通過 DrawLine 方法或繪圖筆工具在放映中繪制的直線。 
 
(5)GotoSlide 方法:用于切換指定幻燈片。
powerpoint 學習筆記: http://www.rdpslides.com/pptlive/index.html
標簽: <無>

代碼片段(2) [全屏查看所有代碼]

1. [代碼]Powerpoint中VBA編程技巧     跳至 [1] [2] [全屏預覽]

0001Sub PowerPointBasics_1() 
0002    ' PowerPoint 的對象模型 Ojbect Model (OM)模型導航 
0003    ' 每個東東在 PowerPoint 中都是某個類型的對象 
0004    ' 想操作好 PowerPoint,你就要和對象打交道 有些對象是另外一些對象的集合。 
0005    ' 對象具有屬性 – 用來描述對象的東東 
0006    ' 對象具有方法 – 對象可以做或你可以對他做什么 
0007    ' 對象模型就是所有 PowerPoint 對象自成一個體系的集合 
0008    ' 就像一個倒置的樹圖 
0009     ' 按 F2 瀏覽查看對象 
0010     ' 數(shù)的最頂層是應用對象(Application) 
0011    ' 就是 PowerPoint 本身 
0012    ' 應用對象有他的屬性 
0013    Debug.Print Application.Name 
0014     ' 用 Debug.Print 代替 MsgBox 能節(jié)省一點時間 
0015     ' 我們就不需要點擊對話框的“確定”按鈕 
0016     ' Debug.Print 的結果輸出在 VB 編輯器環(huán)境中的立即窗口中 
0017     ' 如果它沒有顯示,通過點擊菜單“視圖”/“立即窗口”或者按 Ctrl+G 來顯示 
0018     ' .Presentations 屬性返回當前打開演示文檔的一個集合 
0019     ' 我們通過“點”提示來調用它的功能 
0020     Debug.Print Application.Presentations.Count 
0021     ' 我們可以指定一個特定的對象 
0022   
0023    Debug.Print Application.Presentations(1).Name 
0024   
0025    
0026   
0027    ' 所以說 PowerPoint (即 application 對象) 包含 Presentations 對象 
0028   
0029    ' Presentations 包含 Slides 對象 
0030   
0031    ' Slides 包含 Shapes 對象,如 rectangles 和 circles。 
0032   
0033    ' 所以我們可以自然的這樣寫: 
0034   
0035    Debug.Print Application.ActivePresentation.Slides(2).Shapes.Count 
0036   
0037    
0038   
0039    ' 但是這么長的引用有些令人乏味 
0040   
0041    ' 另一種形式對我們來說更容易一些同時也會讓 PowerPoint 處理的更快一些 
0042   
0043    ' 使用 With 關鍵字來引用你用的對象.. 
0044   
0045    With ActivePresentation.Slides(2).Shapes(2) 
0046   
0047        ' 這樣你可以直接引用他的下級功能 
0048   
0049   
0050   
0051        Debug.Print .Name 
0052   
0053        Debug.Print .Height 
0054   
0055        Debug.Print .Width 
0056   
0057    ' 最后用 End With 關鍵字來表明引用完畢 
0058   
0059    End With 
0060   
0061    
0062   
0063    ' 我們也可以嵌套著使用 
0064   
0065    With ActivePresentation.Slides(2).Shapes(2) 
0066   
0067        Debug.Print .Name 
0068   
0069        With .TextFrame.TextRange 
0070   
0071            Debug.Print .Text 
0072   
0073            Debug.Print .Font.Name 
0074   
0075        End With 
0076   
0077    End With 
0078   
0079    
0080   
0081End Sub 
0082   
0083    
0084   
0085    
0086   
0087Sub PowerPointBasics_2() 
0088   
0089    ' 控制當前選中的對象 
0090   
0091    
0092   
0093    ' 顯示對象的名字 
0094   
0095   
0096   
0097    With ActiveWindow.Selection.ShapeRange(1) 
0098   
0099        Debug.Print .Name 
0100   
0101    End With 
0102   
0103    
0104   
0105    ' 更改名字并移動他: 
0106   
0107    With ActiveWindow.Selection.ShapeRange(1) 
0108   
0109        ' 命名對象非常有用 
0110   
0111        .Name = "My favorite shape" 
0112   
0113        .Left = .Left + 72  ' 72 像素即 1 英寸 
0114   
0115    End With 
0116   
0117    
0118   
0119End Sub 
0120   
0121    
0122   
0123Sub PowerPointBasics_3() 
0124   
0125    ' 控制一個已命名的對象 
0126   
0127    ' 如果你知道一個對象的名字 
0128   
0129    ' 你就可以直接控制他 
0130   
0131    ' 不需要繁瑣的調用了。 
0132   
0133    
0134   
0135    With ActivePresentation.Slides(2).Shapes("My favorite shape"
0136   
0137        .Top = .Top - 72 
0138   
0139    End With 
0140   
0141   
0142   
0143    
0144   
0145    ' 每頁幻燈片也可以有名字 
0146   
0147    With ActivePresentation.Slides(2) 
0148   
0149        .Name = "My favorite slide" 
0150   
0151    End With 
0152   
0153    
0154   
0155    ' 無論我們移動他到那個地方,名字不變 
0156   
0157    ' 這樣我們就可以方便的操作啦 
0158   
0159    With ActivePresentation.Slides("My favorite slide").Shapes("My favorite shape"
0160   
0161        .Height = .Height * 2 
0162   
0163    End With 
0164   
0165    
0166   
0167End Sub 
0168   
0169    
0170   
0171Sub PowerPointBasics_4() 
0172   
0173    ' 對象的引用 
0174   
0175    
0176   
0177    ' 可以通過變量來保持對對象的引用 
0178   
0179    ' 可能會有些難于理解,不過不用擔心 
0180   
0181    ' 參照實例很容易理解的。 
0182   
0183    
0184   
0185    ' 先看下面的例子: 
0186   
0187   
0188   
0189    
0190   
0191    ' 定義一個變量為某個類型 
0192   
0193    Dim oShape As Shape 
0194   
0195    
0196   
0197    ' 讓他指向某個特定的對象 
0198   
0199    Set oShape = ActivePresentation.Slides("My favorite slide").Shapes("My favorite shape"
0200   
0201    ' 注意我們使用已命名的對象。 
0202   
0203    
0204   
0205    ' 從現(xiàn)在開始,我們就可以把 oShape 認作為我們命名的那個對象。 
0206   
0207    Debug.Print oShape.TextFrame.TextRange.Text 
0208   
0209    oShape.TextFrame.TextRange.Font.Color.RGB = RGB(255, 0, 0) 
0210   
0211    ' 直到我們刪除這個變量,都可以認為他就是我們命名的那個對象。 
0212   
0213    
0214   
0215    Set oShape = Nothing 
0216   
0217    
0218   
0219End Sub 
0220   
0221    
0222   
0223Sub PowerPointBasics_5() 
0224   
0225    ' 遍歷所有的幻燈片 
0226   
0227    ' 便利所有的對象 
0228   
0229    
0230   
0231    ' So far, we haven't done anything you couldn't do 
0232   
0233   
0234   
0235    ' with your mouse, and do it more easily at that. 
0236   
0237    ' One more little lesson, then the real fun starts. 
0238   
0239    
0240   
0241    Dim x As Long   ' we'll use X as a counter 
0242   
0243    ' OK, I said always to give variables meaningful names 
0244   
0245    ' But for little "throwaway" jobs like this, programmers often 
0246   
0247    ' use x, y, and the like 
0248   
0249    
0250   
0251    ' Let's do something with every slide in the presentation 
0252   
0253    For x = 1 To ActivePresentation.Slides.Count 
0254   
0255        Debug.Print ActivePresentation.Slides(x).Name 
0256   
0257    Next
0258   
0259    
0260   
0261    ' Or with every shape on one of the slides 
0262   
0263    ' Since x is a "junk" variable, we'll just re-use it here 
0264   
0265    ' And we'll use the With syntax to save some typing 
0266   
0267    With ActivePresentation.Slides(3) 
0268   
0269        For x = 1 To .Shapes.Count 
0270   
0271            Debug.Print .Shapes(x).Name 
0272   
0273        Next
0274   
0275    End With  ' ActivePresentation.Slides(3) 
0276   
0277    
0278   
0279   
0280   
0281End Sub 
0282   
0283    
0284   
0285Sub PowerPointBasics_6() 
0286   
0287    ' 處理異常錯誤 
0288   
0289    
0290   
0291    ' You can trust computer users to do one thing and one thing only: 
0292   
0293    '           The Unexpected 
0294   
0295    ' You can trust computers to do pretty much the same 
0296   
0297    
0298   
0299    ' That's where error handling comes in 
0300   
0301    
0302   
0303    ' What do you think will happen when I run this code? 
0304   
0305    With ActivePresentation.Slides(42) 
0306   
0307        MsgBox ("Steve, you moron, there IS no slide 42!"
0308   
0309    End With 
0310   
0311    
0312   
0313End Sub 
0314   
0315    
0316   
0317Sub PowerPointBasics_6a() 
0318   
0319    ' Error Handling Continued 
0320   
0321    
0322   
0323    ' Let's protect our code against boneheaded Steves 
0324   
0325   
0326   
0327    ' If he does something that provokes an error, deal with it gracefully 
0328   
0329    On Error GoTo ErrorHandler 
0330   
0331    
0332   
0333    With ActivePresentation.Slides(42) 
0334   
0335        MsgBox ("Steve, you moron, there IS no slide 42!"
0336   
0337    End With 
0338   
0339    
0340   
0341' Words with a : at the end are "labels" 
0342   
0343' and can be the destination of a "GoTo" command 
0344   
0345' Using GoTo is considered Very Bad Form except in error handlers 
0346   
0347    
0348   
0349' If we got here without error we need to quit before we hit the error 
0350   
0351' handling code so ... 
0352   
0353NormalExit: 
0354   
0355    Exit Sub 
0356   
0357    
0358   
0359ErrorHandler: 
0360   
0361    MsgBox ("Error: " & Err.Number & vbCrLf & Err.Description) 
0362   
0363    ' resume next 
0364   
0365    ' exit sub 
0366   
0367    Resume NormalExit 
0368   
0369    
0370   
0371   
0372   
0373End Sub 
0374   
0375    
0376   
0377Option Explicit  
0378   
0379Public strText As String  
0380   
0381Public strOption As String  
0382   
0383    
0384   
0385Sub Forms_1()  
0386   
0387    ' Creating/Showing/Unloading a form  
0388   
0389    
0390   
0391    ' Forms are a more sophisticated way of getting user input than  
0392   
0393    ' simple InputBox commands  
0394   
0395    
0396   
0397    ' For example:  
0398   
0399    frmMyForm1.Show  
0400   
0401    
0402   
0403    ' now the user has dismissed the form  
0404   
0405    ' let's see what they entered  
0406   
0407    
0408   
0409    Debug.Print frmMyForm1.TextBox1.Text  
0410   
0411    
0412   
0413    If frmMyForm1.OptionButton1.Value = True Then  
0414   
0415        Debug.Print "Yes"  
0416   
0417   
0418   
0419    End If  
0420   
0421    If frmMyForm1.OptionButton2.Value = True Then  
0422   
0423        Debug.Print "Chocolate"  
0424   
0425    End If  
0426   
0427    If frmMyForm1.OptionButton3.Value = True Then  
0428   
0429        Debug.Print "Teal"  
0430   
0431    End If  
0432   
0433    
0434   
0435    ' we're done with the form so unload it  
0436   
0437    Unload frmMyForm1  
0438   
0439    
0440   
0441    ' But what if we want to make the form data available until much later?  
0442   
0443    ' And wouldn't it make more sense to keep all the form's logic  
0444   
0445    ' in the form itself?  
0446   
0447    
0448   
0449End Sub  
0450   
0451    
0452   
0453Sub Forms_2()  
0454   
0455    ' This uses a form with the logic built in  
0456   
0457    ' Note that we had to declare a few PUBLIC variables  
0458   
0459    ' so the form could get at them  
0460   
0461    
0462   
0463   
0464   
0465    frmMyForm2.Show  
0466   
0467    
0468   
0469    ' we're done with the form so unload it  
0470   
0471    Unload frmMyForm2  
0472   
0473    
0474   
0475    ' let's see what they entered - our variables still have the values  
0476   
0477    ' the form code assigned them:  
0478   
0479    Debug.Print strText  
0480   
0481    Debug.Print strOption  
0482   
0483    
0484   
0485    ' CODE RE-USE  
0486   
0487    ' We can export the form to a file and import it into other projects  
0488   
0489    
0490   
0491End Sub 
0492   
0493    
0494   
0495This is the code from the Animation Tricks section of the seminar (modAnimationTricks)  
0496   
0497    
0498   
0499    
0500   
0501Option Explicit  
0502   
0503    
0504   
0505' This tells VBA how to call on the Windows API Sleep function  
0506   
0507' This function puts our VBA code to sleep for X milliseconds  
0508   
0509   
0510   
0511' (thousandths of a second) then lets it wake up after that  
0512   
0513' Unlike other ways of killing time, this doesn't hog computer cycles  
0514   
0515Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)  
0516   
0517    
0518   
0519Sub xYouClicked(oSh As Shape)  
0520   
0521    Dim oShThought As Shape  
0522   
0523    Set oShThought = oSh.Parent.Shapes("Thought")  
0524   
0525    
0526   
0527    ' Make the thought balloon visible  
0528   
0529    oShThought.Visible = True  
0530   
0531    ' Move it to just to the right of the clicked shape  
0532   
0533    oShThought.Left = oSh.Left + oSh.Width  
0534   
0535    ' Position it vertically just above the clicked shape  
0536   
0537    oShThought.Top = oSh.Top - oShThought.Height  
0538   
0539    
0540   
0541    Select Case UCase(oSh.Name)  
0542   
0543        Case Is = "EENIE"  
0544   
0545            oShThought.TextFrame.TextRange.Text = "Pest!"  
0546   
0547        Case Is = "MEENIE"  
0548   
0549            oShThought.TextFrame.TextRange.Text = "This is annoying!"  
0550   
0551        Case Is = "MINIE"  
0552   
0553            oShThought.TextFrame.TextRange.Text = "This is REALLY annoying!!"  
0554   
0555   
0556   
0557        Case Is = "MOE"  
0558   
0559            oShThought.Visible = False  
0560   
0561            oSh.Parent.Shapes("STOP").Visible = True  
0562   
0563    End Select  
0564   
0565    
0566   
0567End Sub  
0568   
0569    
0570   
0571Sub yYouClicked(oSh As Shape)  
0572   
0573    ' This time we'll use tags to make it easier to maintain  
0574   
0575    
0576   
0577    Dim oShThought As Shape  
0578   
0579    Set oShThought = oSh.Parent.Shapes("Thought")  
0580   
0581    
0582   
0583    ' Make the thought balloon visible and move it next to the  
0584   
0585    ' shape the user just clicked  
0586   
0587    oShThought.Visible = True  
0588   
0589    oShThought.Left = oSh.Left + oSh.Width  
0590   
0591    oShThought.Top = oSh.Top - oShThought.Height  
0592   
0593    
0594   
0595    ' Use tags to pick up the text  
0596   
0597    oShThought.TextFrame.TextRange.Text = oSh.Tags("Thought")  
0598   
0599    
0600   
0601   
0602   
0603End Sub  
0604   
0605    
0606   
0607Sub AddATag()  
0608   
0609    ' A little macro to add a tag to the selected shape  
0610   
0611    Dim strTag As String  
0612   
0613    
0614   
0615    ' Our old buddy InputBox gets the tag text ...  
0616   
0617    strTag = InputBox("Type the text for the thought balloon", "What is the shape thinking?")  
0618   
0619    
0620   
0621    ' Instead of forcing user to enter something, we'll just quit  
0622   
0623    ' if not  
0624   
0625    If strTag = "" Then  
0626   
0627        Exit Sub  
0628   
0629    End If  
0630   
0631    
0632   
0633    ' Must have entered something, so tag the shape with it  
0634   
0635    With ActiveWindow.Selection.ShapeRange(1)  
0636   
0637        .Tags.Add "Thought", strTag  
0638   
0639    End With  
0640   
0641End Sub  
0642   
0643    
0644   
0645Sub YouClicked(oSh As Shape)  
0646   
0647   
0648   
0649    ' And now we'll add a WinAPI Sleep call to make it even smoother  
0650   
0651    
0652   
0653    Dim oShThought As Shape  
0654   
0655    Set oShThought = oSh.Parent.Shapes("Thought")  
0656   
0657    
0658   
0659    ' Use tags to pick up the text  
0660   
0661    oShThought.TextFrame.TextRange.Text = oSh.Tags("Thought")  
0662   
0663    
0664   
0665    ' Make the thought balloon visible and move it next to the  
0666   
0667    ' shape the user just clicked  
0668   
0669    oShThought.Left = oSh.Left + oSh.Width  
0670   
0671    oShThought.Top = oSh.Top - oShThought.Height  
0672   
0673    oShThought.Visible = True  
0674   
0675    
0676   
0677    ' give the system a little time to redraw  
0678   
0679    DoEvents  
0680   
0681    
0682   
0683    ' Now wait a second (1000 milliseconds to be precise) ...  
0684   
0685    Sleep 1000  
0686   
0687    ' and make it invisible again  
0688   
0689    oShThought.Visible = False  
0690   
0691    
0692   
0693   
0694   
0695End Sub  
0696   
0697    
0698   
0699    
0700   
0701Sub Reset()  
0702   
0703    ' Re-bait our little trap so it's ready for the next  
0704   
0705    ' unwary user  
0706   
0707    ActivePresentation.Slides("AnimationTricks").Shapes("STOP").Visible = False  
0708   
0709    ActivePresentation.Slides("AnimationTricks").Shapes("Thought").Visible = False  
0710   
0711End Sub 
0712   
0713    
0714   
0715    
0716   
0717This is the code from the Mass Quantities section of the seminar (modMassQuantities) that deals 
0718with automating actions across many slides or many presentations.  
0719   
0720    
0721   
0722    
0723   
0724Option Explicit  
0725   
0726    
0727   
0728Sub GreenToRed()  
0729   
0730    ' Object variables for Slides and Shapes  
0731   
0732    Dim oSh As Shape  
0733   
0734    Dim oSl As Slide  
0735   
0736    
0737   
0738    For Each oSl In ActivePresentation.Slides  
0739   
0740   
0741   
0742        For Each oSh In oSl.Shapes  
0743   
0744            If oSh.Fill.ForeColor.RGB = RGB(0, 255, 0) Then  
0745   
0746                oSh.Fill.ForeColor.RGB = RGB(255, 0, 0)  
0747   
0748            End If  
0749   
0750        Next oSh  
0751   
0752    Next oSl  
0753   
0754    
0755   
0756End Sub  
0757   
0758    
0759   
0760Sub FolderFull()  
0761   
0762    ' For each presentation in a folder that matches our specifications  
0763   
0764    '   - open the file  
0765   
0766    '   - call another subroutine that does something to it  
0767   
0768    '   - save the file  
0769   
0770    '   - close the file  
0771   
0772    
0773   
0774    Dim strCurrentFile As String    ' variable to hold a single file name  
0775   
0776    Dim strFileSpec As String       ' variable to hold our file spec  
0777   
0778    ' give it a value that works for my computer:  
0779   
0780    strFileSpec 
0781
0782"C:\Documents 
0783and 
0784Settings\Stephen 
0785Rindsberg\Desktop\PPTLive\Automation\LotsOfFiles\*.ppt"  
0786   
0787    
0788   
0789   
0790   
0791    ' get the first file that matches our specification  
0792   
0793    strCurrentFile = Dir$(strFileSpec)  
0794   
0795    
0796   
0797    ' don't do anything if we didn't find any matching files  
0798   
0799    ' but if we did, keep processing files until we don't find any more  
0800   
0801    While Len(strCurrentFile) > 0  
0802   
0803        ' open the presentation  
0804   
0805        Presentations.Open (strCurrentFile)  
0806   
0807    
0808   
0809        ' by changing this next line to call a different subroutine  
0810   
0811        ' you can have this same code do other tasks  
0812   
0813        Debug.Print ActivePresentation.Name  
0814   
0815    
0816   
0817        ' call the Green to Red macro to process the file  
0818   
0819        Call GreenToRed  
0820   
0821    
0822   
0823        ' save the file under a new name with FIXED_ at the beginning  
0824   
0825        ActivePresentation.SaveAs (ActivePresentation.Path & "\" _  
0826   
0827            & "Fixed_" _  
0828   
0829            & ActivePresentation.Name)  
0830   
0831    
0832   
0833        ' close it  
0834   
0835   
0836   
0837        ActivePresentation.Close  
0838   
0839        ' and get the next file that matches our specification  
0840   
0841        ' if you don't supply a new file spec, Dir$ returns the next  
0842   
0843        ' file that matches the previously supplied specification  
0844   
0845        strCurrentFile = Dir$  
0846   
0847    Wend  
0848   
0849    
0850   
0851    ' Note: Don't use Dir in code that's called from within a loop  
0852   
0853    ' that uses Dir - only one "Dir" can be "active" at a time.  
0854   
0855    ' In production code, it's best to keep it in a very short loop or  
0856   
0857    ' to collect file names in a short loop then process them after  
0858   
0859    ' Arrays are useful for this  
0860   
0861    
0862   
0863End Sub 
0864   
0865    
0866   
0867Misc. Example code from the seminar (modMiscExamples)  
0868   
0869    
0870   
0871    
0872   
0873    
0874   
0875Option Explicit  
0876   
0877    
0878   
0879Sub FolderFullFromArray()  
0880   
0881   
0882   
0883    ' Uses array to collect filenames for processing  
0884   
0885    ' This is more reliable than processing the files within a loop  
0886   
0887    ' that includes DIR  
0888   
0889    
0890   
0891    Dim rayFileNames() As String  
0892   
0893    Dim strCurrentFile As String    ' variable to hold a single file name  
0894   
0895    Dim strFileSpec As String       ' variable to hold our file spec  
0896   
0897    ' give it a value that works for my computer:  
0898   
0899    strFileSpec 
0900
0901"C:\Documents 
0902and 
0903Settings\Stephen 
0904Rindsberg\Desktop\PPTLive\Automation\LotsOfFiles\*.ppt"  
0905   
0906    
0907   
0908    ' Redimension the array to 1 element  
0909   
0910    ReDim rayFileNames(1 To 1) As String  
0911   
0912    
0913   
0914    ' get the first file that matches our specification  
0915   
0916    strCurrentFile = Dir$(strFileSpec)  
0917   
0918    
0919   
0920    ' don't do anything if we didn't find any matching files  
0921   
0922    ' but if we did, keep processing files until we don't find any more  
0923   
0924    While Len(strCurrentFile) > 0  
0925   
0926        ' Add it to the array  
0927   
0928        rayFileNames(UBound(rayFileNames)) = strCurrentFile  
0929   
0930        strCurrentFile = Dir  
0931   
0932   
0933   
0934        ' redimension the array  
0935   
0936        ReDim Preserve rayFileNames(1 To UBound(rayFileNames) + 1) As String  
0937   
0938    Wend  
0939   
0940    
0941   
0942    ' If there were no files, the array has one element  
0943   
0944    ' If it has more than one element, the last element is blank  
0945   
0946    If UBound(rayFileNames) > 1 Then  
0947   
0948        ' lop off the last, empty element  
0949   
0950        ReDim Preserve rayFileNames(1 To UBound(rayFileNames) - 1) As String  
0951   
0952    Else  
0953   
0954        ' no files found  
0955   
0956        Exit Sub  
0957   
0958    End If  
0959   
0960    
0961   
0962    ' If we got this far, we have files to process in the array so  
0963   
0964    Dim x As Long  
0965   
0966    
0967   
0968    For x = 1 To UBound(rayFileNames)  
0969   
0970    
0971   
0972        ' open the presentation  
0973   
0974        Presentations.Open (rayFileNames(x))  
0975   
0976        Debug.Print ActivePresentation.Name  
0977   
0978   
0979   
0980    
0981   
0982        ' call the Green to Red macro to process the file  
0983   
0984        Call GreenToRed  
0985   
0986    
0987   
0988        ' save the file under a new name with FIXED_ at the beginning  
0989   
0990        ActivePresentation.SaveAs (ActivePresentation.Path & "\" _  
0991   
0992            & "Fixed_" _  
0993   
0994            & ActivePresentation.Name)  
0995   
0996    
0997   
0998        ' close it  
0999   
1000        ActivePresentation.Close  
1001   
1002    Next x  
1003   
1004    
1005   
1006End Sub 
1007   
1008    
1009   
1010This is the code from the Macro Recorder demonstration  
1011   
1012    
1013   
1014    
1015   
1016The Macro Recorder is handy for little quickie macros and especially for learning how 
1017PowerPoint's object model works, but it doesn't produce code that's very useful as is.  
1018   
1019    
1020   
1021    
1022   
1023   
1024   
1025This demonstrates how you can make the recorder produce more useful code and how you can 
1026take what you've learned from it and tweak it into something more generally useful.  
1027   
1028    
1029   
1030    
1031   
1032Suppose the corporate colors have just changed from green to red. You've got dozens or hundreds 
1033of presentations with the fills set to the old green and need to change them all. Fast.  
1034   
1035    
1036   
1037    
1038   
1039You open one in PPT and record a macro while you select a shape and change its color from green 
1040to red.  
1041   
1042Here's what you end up with:  
1043   
1044    
1045   
1046    
1047   
1048Sub Macro1()  
1049   
1050    
1051   
1052    ActiveWindow.Selection.SlideRange.Shapes("Rectangle 5").Select  
1053   
1054    With ActiveWindow.Selection.ShapeRange  
1055   
1056        .Fill.Visible = msoTrue  
1057   
1058        .Fill.ForeColor.RGB = RGB(255, 0, 102)  
1059   
1060        .Fill.Solid  
1061   
1062    End With  
1063   
1064    ActivePresentation.ExtraColors.Add RGB(Red:=255, Green:=0, Blue:=102)  
1065   
1066    
1067   
1068End Sub  
1069   
1070   
1071   
1072    
1073   
1074This has a few problems:  
1075   
1076    
1077   
1078It only works IF there's a shape named "Rectangle 5" on the current slide   
1079   
1080It will only change a shape by that name, no other   
1081   
1082It changes things we may not WANT changed (.Fill.Solid, .Fill.Visible)   
1083   
1084It adds extra colors to the PPT palette (.ExtraColors)   
1085   
1086    
1087   
1088In short, it solves the problem of changing ONE shape on ONE slide from green to red. And that's 
1089it. And it creates other potential problems in the process.  
1090   
1091    
1092   
1093    
1094   
1095But it did show us how to change a shape's color in PowerPoint VBA, so it's not totally useless.  
1096   
1097    
1098   
1099    
1100   
1101Let's see if we can get it to do something more general.  
1102   
1103Select the green rectangle first, THEN record a macro while changing it to red:  
1104   
1105    
1106   
1107    
1108   
1109Sub Macro2()  
1110   
1111    
1112   
1113    With ActiveWindow.Selection.ShapeRange  
1114   
1115   
1116   
1117        .Fill.ForeColor.RGB = RGB(255, 0, 102)  
1118   
1119        .Fill.Visible = msoTrue  
1120   
1121        .Fill.Solid  
1122   
1123    End With  
1124   
1125    
1126   
1127End Sub  
1128   
1129    
1130   
1131That's better. A lot better. It works on any selected shape and in fact it works on multiple selected 
1132shapes.  
1133   
1134It still sets a few extra properties but we can comment those out.  
1135   
1136Now you can select all the shapes on each slide, run this macro and ...  
1137   
1138    
1139   
1140    
1141   
1142No. Don't do that. It'll change all the green selected shapes to red, true. Also all the blue ones and 
1143purple ones and so on. ALL the selected shapes.  
1144   
1145    
1146   
1147    
1148   
1149So you still have to go from slide to slide selecting all (and ONLY) the green shapes, then running 
1150the macro again and again.  
1151   
1152    
1153   
1154    
1155   
1156Enough of this. Here's how you and the other VBA Pros really do this kind of stuff:  
1157   
1158    
1159   
1160    
1161   
1162   
1163   
1164Sub GreenToRed()  
1165   
1166    
1167   
1168    Dim oSh As Shape  
1169   
1170    Dim oSl As Slide  
1171   
1172    
1173   
1174    ' Look at each slide in the current presentation:  
1175   
1176    For Each oSl In ActivePresentation.Slides  
1177   
1178    
1179   
1180        ' Look at each shape on each slide:  
1181   
1182        For Each oSh In oSl.Shapes  
1183   
1184    
1185   
1186            ' IF the shape's .Fill.ForeColor.RGB = pure green:  
1187   
1188            If oSh.Fill.ForeColor.RGB = RGB(0, 255, 0) Then  
1189   
1190    
1191   
1192                ' Change it to red  
1193   
1194                oSh.Fill.ForeColor.RGB = RGB(255, 0, 0)  
1195   
1196    
1197   
1198            End If  
1199   
1200    
1201   
1202        Next oSh  
1203   
1204    
1205   
1206    Next oSl  
1207   
1208   
1209   
1210    
1211   
1212End Sub  
1213   
1214    
1215   
1216In less time than it takes you to get your finger off the mouse button, that will change thousands of 
1217shapes on hundreds of slides from green to red. And it only touches the shapes that are the exact 
1218shade of green we've targeted, no other colors.  
1219   
1220Is it safe to touch the text? 
1221Not all shapes can have text. If you try to access a text property of one of these, PowerPoint errors 
1222out. 
1223In addition, some shapes created by PowerPoint 97 can be corrupted to the point where, though 
1224they have the ability to hold text, they cause errors if you try to check for the text. 
1225   
1226   
1227This is kind of a safety check function. It tests the various things that might cause errors and 
1228returns True if none of them actually cause errors. 
1229   
1230   
1231Public Function IsSafeToTouchText(pShape As Shape) As Boolean 
1232   
1233 On Error GoTo Errorhandler 
1234   
1235 If pShape.HasTextFrame Then 
1236  If pShape.TextFrame.HasText Then 
1237   ' Errors here if it's a bogus shape:  
1238   If Len(pShape.TextFrame.TextRange.text) > 0 Then 
1239    ' it's safe to touch it 
1240    IsSafeToTouchText = True 
1241    Exit Function 
1242   End If ' Length > 0 
1243  End If ' HasText 
1244 End If ' HasTextFrame 
1245   
1246Normal_Exit: 
1247 IsSafeToTouchText = False 
1248 Exit Function 
1249   
1250Errorhandler: 
1251 IsSafeToTouchText = False 
1252 Exit Function 
1253   
1254   
1255   
1256End Function 
1257   
1258   
1259What's the path to the PPA (add-in) file?  
1260   
1261If your add-in requires additional files, you'll probably keep them in the same folder as the add-in 
1262itself.  
1263   
1264    
1265   
1266    
1267   
1268Ah, but where's that? A user might install an add-in from anywhere on the local hard drive or even 
1269from a network drive, so you can't be certain where the add-in and its associated files are. At least 
1270not without this:  
1271   
1272    
1273   
1274    
1275   
1276Public Function PPAPath(AddinName as String) As String  
1277   
1278' Returns the path to the named add-in if found, null if not  
1279   
1280' Dependencies:  SlashTerminate (listed below, explained later)  
1281   
1282    
1283   
1284       Dim x As Integer  
1285   
1286       PPAPath = ""  
1287   
1288    
1289   
1290       For x = 1 To Application.AddIns.count  
1291   
1292              If UCase(Application.AddIns(x).Name) = UCase(AddinName) Then  
1293   
1294                     ' we found it, so  
1295   
1296                     PPAPath = Application.AddIns(x).path & GetPathSeparator  
1297   
1298                     ' no need to check any other addins  
1299   
1300   
1301   
1302                     Exit Function  
1303   
1304              End If  
1305   
1306       Next x  
1307   
1308    
1309   
1310       ' So we can run it from a PPT in the IDE instead of a PPA:  
1311   
1312       If PPAPath = "" Then  
1313   
1314              PPAPath = SlashTerminate(ActivePresentation.path)  
1315   
1316       End If  
1317   
1318    
1319   
1320End Function  
1321   
1322    
1323   
1324Function SlashTerminate(sPath as String) as String  
1325   
1326' Returns a string terminated with a path separator character  
1327   
1328' Works on PC or Mac  
1329   
1330    
1331   
1332       Dim PathSep As String  
1333   
1334       #If Mac Then  
1335   
1336              PathSep = ":"  
1337   
1338       #Else  
1339   
1340              PathSep = "\"  
1341   
1342       #End If  
1343   
1344    
1345   
1346   
1347   
1348       ' Is the rightmost character a backslash?  
1349   
1350       If Right$(sPath,1) <> PathSep Then  
1351   
1352              ' No; add a backslash  
1353   
1354              SlashTerminate = sPath & PathSep  
1355   
1356       Else  
1357   
1358              SlashTerminate = sPath  
1359   
1360       End If  
1361   
1362    
1363   
1364End Function

2. [代碼][ASP/Basic]代碼     跳至 [1] [2] [全屏預覽]

01ActivePresentation.Slides(2).Shapes.Placeholders(1).Delete
02ActivePresentation.Save
03ActivePresentation.NewWindow
04  
05創(chuàng)建ppt文檔。增加一張slide
06With Presentations.Add
07    .Slides.Add Index:=1, Layout:=ppLayoutTitle
08    .SaveAs "Sample"
09End With
10  
11打開ppt文檔。
12Presentations.Open FileName:="c:\My Documents\pres1.ppt", _
13    ReadOnly:=msoTrue
14  
15創(chuàng)建保存ppt
16Sub AddAndSave(pptPres As Presentation)
17    pptPres.Slides.Add 1, 1
18    pptPres.SaveAs pptPres.Application.Path & "\Added Slide"
19End Sub
20  
21Slide標題刪除與恢復
22ActivePresentation.Slides(2).Shapes.Placeholders(1).Delete
23Application.ActivePresentation.Slides(2) _
24    .Shapes.AddPlaceholder ppPlaceholderTitle
25  
26當前演示文稿中添加一張幻燈片,為該幻燈片標題(幻燈片第一個占位符)和副標題添加文本
27Set myDocument = ActivePresentation.Slides(1)
28With ActivePresentation.Slides _
29        .Add(1, ppLayoutTitle).Shapes.Placeholders
30    .Item(1).TextFrame.TextRange.Text = "This is the title text"
31    .Item(2).TextFrame.TextRange.Text = "This is subtitle text"
32End With
33  
34將主題或設計模式應用于當前ppt
35ActivePresentation.ApplyTheme
36  
37若要在幻燈片中添加形狀并返回一個代表新建形狀的 Shape 對象,請使用 Shapes 集合的下列方法之一:AddCallout 、AddComment 、AddConnector 、AddCurve 、AddLabel 、AddLine 、AddMediaObject 、AddOLEObject 、AddPicture 、AddPlaceholder 、AddPolyline 、AddShape 、AddTable 、AddTextbox 、AddTextEffect 、AddTitle 。
38  
39使用 Shapes.Title 返回代表幻燈片標題的 Shape 對象。使用 Shapes.AddTitle 在無標題的幻燈片中添加標題并返回代表新建標題的 Shape 對象。
40使用Shapes.Placeholders(index) 返回一個代表占位符的 Shape 對象,其中 index 是占位符的索引號。
41如果沒有改變過幻燈片中形狀的排列順序,則以下三個語句是等價的(假設第一張幻燈片有標題)。
42ActivePresentation.Slides(1).Shapes.Title _
43    .TextFrame.TextRange.Font.Italic = True
44ActivePresentation.Slides(1).Shapes.Placeholders(1) _
45    .TextFrame.TextRange.Font.Italic = True
46ActivePresentation.Slides(1).Shapes(1).TextFrame _
47    .TextRange.Font.Italic = True
48  
49使用 HasTextFrame 屬性判斷形狀是否含有文本框,并使用 HasText 屬性判斷該文本框是否包含文本,如以下示例所示。
50Set myDocument = ActivePresentation.Slides(1)
51For Each s In myDocument.Shapes
52    If s.HasTextFrame Then
53        With s.TextFrame
54            If .HasText Then MsgBox .TextRange.Text
55        End With
56    End If
57Next
58  
59使用 TextFrame 對象的 TextRange 屬性返回任意指定形狀的 TextRange 對象。使用 Text 屬性返回 TextRange 對象中的文本字符串。以下示例向 myDocument 中添加一個矩形并設置其包含的文本
60Set myDocument = ActivePresentation.Slides(1)
61myDocument.Shapes.AddShape(msoShapeRectangle, 0, 0, 250, 140) _
62    .TextFrame.TextRange.Text = "Here is some test text"
63  
64使用 HasTextFrame 屬性判斷形狀是否含有文本框,然后使用 HasText 屬性判斷該文本框是否包含文本。
65使用 Selection 對象的 TextRange 屬性返回當前選定的文字。以下示例將選定內容復制到剪貼板。
66ActiveWindow.Selection.TextRange.Copy
67  
68使用下列方法之一可返回 TextRange 對象中的部分文本:Characters、Lines、Paragraphs、Runs、Sentences 或 Words。
69使用 Find 和 Replace 方法可查找和替換文本范圍內的文本。
70使用下列方法之一可向 TextRange 對象中插入字符:InsertAfter、InsertBefore、InsertDateTime、InsertSlideNumber 或 InsertSymbol。
71  
72本示例創(chuàng)建活動演示文稿中第一張幻燈片的一個副本,然后設置新幻燈片的背景陰影和標題文本。新幻燈片將作為演示文稿的第二張幻燈片。
73Set newSlide = ActivePresentation.Slides(1).Duplicate
74With newSlide
75    .Background.Fill.PresetGradient msoGradientVertical, _
76        1, msoGradientGold
77    .Shapes.Title.TextFrame.TextRange _
78        .Text = "Second Quarter Earnings"
79End With
80  
81增加回車換行控制符
82Chr(13) & Chr(10)
本站僅提供存儲服務,所有內容均由用戶發(fā)布,如發(fā)現(xiàn)有害或侵權內容,請點擊舉報。
打開APP,閱讀全文并永久保存 查看更多類似文章
猜你喜歡
類似文章
用VBA去操作PowerPoint
PPT VBA小白入門之5段有代表性代碼
TextRange 對象 (PowerPoint) | Microsoft Learn
在PowerPoint里實現(xiàn)3D模型對象的復位——兼談方法和屬性的區(qū)別
PPT轉Word的4個實例,含怎么把大綱不顯示文字的PPT轉換Word和如何保留原格式將PPT轉換成...
一鍵就可以提取PPT中全部文字
更多類似文章 >>
生活服務
熱點新聞
分享 收藏 導長圖 關注 下載文章
綁定賬號成功
后續(xù)可登錄賬號暢享VIP特權!
如果VIP功能使用有故障,
可點擊這里聯(lián)系客服!

聯(lián)系客服