0001 | Sub 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 | |
0081 | End Sub |
0082 | |
0083 | |
0084 | |
0085 | |
0086 | |
0087 | Sub 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 | |
0119 | End Sub |
0120 | |
0121 | |
0122 | |
0123 | Sub 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 | |
0167 | End Sub |
0168 | |
0169 | |
0170 | |
0171 | Sub 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 | |
0219 | End Sub |
0220 | |
0221 | |
0222 | |
0223 | Sub 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 x |
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 x |
0274 | |
0275 | End With ' ActivePresentation.Slides(3) |
0276 | |
0277 | |
0278 | |
0279 | |
0280 | |
0281 | End Sub |
0282 | |
0283 | |
0284 | |
0285 | Sub 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 | |
0313 | End Sub |
0314 | |
0315 | |
0316 | |
0317 | Sub 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 | |
0353 | NormalExit: |
0354 | |
0355 | Exit Sub |
0356 | |
0357 | |
0358 | |
0359 | ErrorHandler: |
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 | |
0373 | End Sub |
0374 | |
0375 | |
0376 | |
0377 | Option Explicit |
0378 | |
0379 | Public strText As String |
0380 | |
0381 | Public strOption As String |
0382 | |
0383 | |
0384 | |
0385 | Sub 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 | |
0449 | End Sub |
0450 | |
0451 | |
0452 | |
0453 | Sub 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 | |
0491 | End Sub |
0492 | |
0493 | |
0494 | |
0495 | This is the code from the Animation Tricks section of the seminar (modAnimationTricks) |
0496 | |
0497 | |
0498 | |
0499 | |
0500 | |
0501 | Option 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 | |
0515 | Private Declare Sub Sleep Lib "kernel32" ( ByVal dwMilliseconds As Long ) |
0516 | |
0517 | |
0518 | |
0519 | Sub 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 | |
0567 | End Sub |
0568 | |
0569 | |
0570 | |
0571 | Sub 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 | |
0603 | End Sub |
0604 | |
0605 | |
0606 | |
0607 | Sub 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 | |
0641 | End Sub |
0642 | |
0643 | |
0644 | |
0645 | Sub 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 | |
0695 | End Sub |
0696 | |
0697 | |
0698 | |
0699 | |
0700 | |
0701 | Sub 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 | |
0711 | End Sub |
0712 | |
0713 | |
0714 | |
0715 | |
0716 | |
0717 | This is the code from the Mass Quantities section of the seminar (modMassQuantities) that deals |
0718 | with automating actions across many slides or many presentations. |
0719 | |
0720 | |
0721 | |
0722 | |
0723 | |
0724 | Option Explicit |
0725 | |
0726 | |
0727 | |
0728 | Sub 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 | |
0756 | End Sub |
0757 | |
0758 | |
0759 | |
0760 | Sub 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 |
0783 | and |
0784 | Settings\Stephen |
0785 | Rindsberg\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 | |
0863 | End Sub |
0864 | |
0865 | |
0866 | |
0867 | Misc. Example code from the seminar (modMiscExamples) |
0868 | |
0869 | |
0870 | |
0871 | |
0872 | |
0873 | |
0874 | |
0875 | Option Explicit |
0876 | |
0877 | |
0878 | |
0879 | Sub 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 |
0902 | and |
0903 | Settings\Stephen |
0904 | Rindsberg\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 | |
1006 | End Sub |
1007 | |
1008 | |
1009 | |
1010 | This is the code from the Macro Recorder demonstration |
1011 | |
1012 | |
1013 | |
1014 | |
1015 | |
1016 | The Macro Recorder is handy for little quickie macros and especially for learning how |
1017 | PowerPoint 's object model works, but it doesn't produce code that's very useful as is. |
1018 | |
1019 | |
1020 | |
1021 | |
1022 | |
1023 | |
1024 | |
1025 | This demonstrates how you can make the recorder produce more useful code and how you can |
1026 | take what you 've learned from it and tweak it into something more generally useful. |
1027 | |
1028 | |
1029 | |
1030 | |
1031 | |
1032 | Suppose the corporate colors have just changed from green to red. You 've got dozens or hundreds |
1033 | of presentations with the fills set to the old green and need to change them all. Fast. |
1034 | |
1035 | |
1036 | |
1037 | |
1038 | |
1039 | You open one in PPT and record a macro while you select a shape and change its color from green |
1040 | to red. |
1041 | |
1042 | Here 's what you end up with: |
1043 | |
1044 | |
1045 | |
1046 | |
1047 | |
1048 | Sub 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 | |
1068 | End Sub |
1069 | |
1070 | |
1071 | |
1072 | |
1073 | |
1074 | This has a few problems: |
1075 | |
1076 | |
1077 | |
1078 | It only works IF there 's a shape named "Rectangle 5" on the current slide |
1079 | |
1080 | It will only change a shape by that name, no other |
1081 | |
1082 | It changes things we may not WANT changed (.Fill.Solid, .Fill.Visible) |
1083 | |
1084 | It adds extra colors to the PPT palette (.ExtraColors) |
1085 | |
1086 | |
1087 | |
1088 | In short, it solves the problem of changing ONE shape on ONE slide from green to red. And that 's |
1089 | it. And it creates other potential problems in the process. |
1090 | |
1091 | |
1092 | |
1093 | |
1094 | |
1095 | But 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 | |
1101 | Let 's see if we can get it to do something more general. |
1102 | |
1103 | Select the green rectangle first, THEN record a macro while changing it to red: |
1104 | |
1105 | |
1106 | |
1107 | |
1108 | |
1109 | Sub 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 | |
1127 | End Sub |
1128 | |
1129 | |
1130 | |
1131 | That 's better. A lot better. It works on any selected shape and in fact it works on multiple selected |
1132 | shapes. |
1133 | |
1134 | It still sets a few extra properties but we can comment those out. |
1135 | |
1136 | Now you can select all the shapes on each slide, run this macro and ... |
1137 | |
1138 | |
1139 | |
1140 | |
1141 | |
1142 | No. Don 't do that. It'll change all the green selected shapes to red, true. Also all the blue ones and |
1143 | purple ones and so on. ALL the selected shapes. |
1144 | |
1145 | |
1146 | |
1147 | |
1148 | |
1149 | So you still have to go from slide to slide selecting all (and ONLY) the green shapes, then running |
1150 | the macro again and again. |
1151 | |
1152 | |
1153 | |
1154 | |
1155 | |
1156 | Enough of this. Here 's how you and the other VBA Pros really do this kind of stuff: |
1157 | |
1158 | |
1159 | |
1160 | |
1161 | |
1162 | |
1163 | |
1164 | Sub 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 | |
1212 | End Sub |
1213 | |
1214 | |
1215 | |
1216 | In less time than it takes you to get your finger off the mouse button, that will change thousands of |
1217 | shapes on hundreds of slides from green to red. And it only touches the shapes that are the exact |
1218 | shade of green we 've targeted, no other colors. |
1219 | |
1220 | Is it safe to touch the text? |
1221 | Not all shapes can have text. If you try to access a text property of one of these, PowerPoint errors |
1222 | out. |
1223 | In addition, some shapes created by PowerPoint 97 can be corrupted to the point where, though |
1224 | they have the ability to hold text, they cause errors if you try to check for the text. |
1225 | |
1226 | |
1227 | This is kind of a safety check function. It tests the various things that might cause errors and |
1228 | returns True if none of them actually cause errors. |
1229 | |
1230 | |
1231 | Public 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 | |
1246 | Normal_Exit: |
1247 | IsSafeToTouchText = False |
1248 | Exit Function |
1249 | |
1250 | Errorhandler: |
1251 | IsSafeToTouchText = False |
1252 | Exit Function |
1253 | |
1254 | |
1255 | |
1256 | End Function |
1257 | |
1258 | |
1259 | What 's the path to the PPA (add-in) file? |
1260 | |
1261 | If your add-in requires additional files, you 'll probably keep them in the same folder as the add-in |
1262 | itself. |
1263 | |
1264 | |
1265 | |
1266 | |
1267 | |
1268 | Ah, but where 's that? A user might install an add-in from anywhere on the local hard drive or even |
1269 | from a network drive, so you can 't be certain where the add-in and its associated files are. At least |
1270 | not without this: |
1271 | |
1272 | |
1273 | |
1274 | |
1275 | |
1276 | Public 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 | |
1320 | End Function |
1321 | |
1322 | |
1323 | |
1324 | Function 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 | |
1364 | End Function |
01 | ActivePresentation.Slides(2).Shapes.Placeholders(1).Delete |
02 | ActivePresentation.Save |
03 | ActivePresentation.NewWindow |
04 | |
05 | 創(chuàng)建ppt文檔。增加一張slide |
06 | With Presentations.Add |
07 | .Slides.Add Index:=1, Layout:=ppLayoutTitle |
08 | .SaveAs "Sample" |
09 | End With |
10 | |
11 | 打開ppt文檔。 |
12 | Presentations.Open FileName:= "c:\My Documents\pres1.ppt" , _ |
13 | ReadOnly :=msoTrue |
14 | |
15 | 創(chuàng)建保存ppt |
16 | Sub AddAndSave(pptPres As Presentation) |
17 | pptPres.Slides.Add 1, 1 |
18 | pptPres.SaveAs pptPres.Application.Path & "\Added Slide" |
19 | End Sub |
20 | |
21 | Slide標題刪除與恢復 |
22 | ActivePresentation.Slides(2).Shapes.Placeholders(1).Delete |
23 | Application.ActivePresentation.Slides(2) _ |
24 | .Shapes.AddPlaceholder ppPlaceholderTitle |
25 | |
26 | 當前演示文稿中添加一張幻燈片,為該幻燈片標題(幻燈片第一個占位符)和副標題添加文本 |
27 | Set myDocument = ActivePresentation.Slides(1) |
28 | With 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" |
32 | End With |
33 | |
34 | 將主題或設計模式應用于當前ppt |
35 | ActivePresentation.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 | 如果沒有改變過幻燈片中形狀的排列順序,則以下三個語句是等價的(假設第一張幻燈片有標題)。 |
42 | ActivePresentation.Slides(1).Shapes.Title _ |
43 | .TextFrame.TextRange.Font.Italic = True |
44 | ActivePresentation.Slides(1).Shapes.Placeholders(1) _ |
45 | .TextFrame.TextRange.Font.Italic = True |
46 | ActivePresentation.Slides(1).Shapes(1).TextFrame _ |
47 | .TextRange.Font.Italic = True |
48 | |
49 | 使用 HasTextFrame 屬性判斷形狀是否含有文本框,并使用 HasText 屬性判斷該文本框是否包含文本,如以下示例所示。 |
50 | Set myDocument = ActivePresentation.Slides(1) |
51 | For 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 |
57 | Next |
58 | |
59 | 使用 TextFrame 對象的 TextRange 屬性返回任意指定形狀的 TextRange 對象。使用 Text 屬性返回 TextRange 對象中的文本字符串。以下示例向 myDocument 中添加一個矩形并設置其包含的文本 |
60 | Set myDocument = ActivePresentation.Slides(1) |
61 | myDocument.Shapes.AddShape(msoShapeRectangle, 0, 0, 250, 140) _ |
62 | .TextFrame.TextRange.Text = "Here is some test text" |
63 | |
64 | 使用 HasTextFrame 屬性判斷形狀是否含有文本框,然后使用 HasText 屬性判斷該文本框是否包含文本。 |
65 | 使用 Selection 對象的 TextRange 屬性返回當前選定的文字。以下示例將選定內容復制到剪貼板。 |
66 | ActiveWindow.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)建活動演示文稿中第一張幻燈片的一個副本,然后設置新幻燈片的背景陰影和標題文本。新幻燈片將作為演示文稿的第二張幻燈片。 |
73 | Set newSlide = ActivePresentation.Slides(1).Duplicate |
74 | With newSlide |
75 | .Background.Fill.PresetGradient msoGradientVertical, _ |
76 | 1, msoGradientGold |
77 | .Shapes.Title.TextFrame.TextRange _ |
78 | .Text = "Second Quarter Earnings" |
79 | End With |
80 | |
81 | 增加回車換行控制符 |
82 | Chr(13) & Chr(10) |
聯(lián)系客服