0度跨越

设置和获取幻灯片的大小

Sub SetSlideSize()
      ' 这个常数用于把单位设为英寸
      Const PTS As Byte = 72
      With ActivePresentation.PageSetup
         .SlideWidth = 8 * PTS '8英寸
         .SlideHeight = 6 * PTS
      End With
   End Sub

Sub GetSlideSize()
      Dim Width As Single
      Dim Height As Single
      With ActivePresentation.PageSetup
         Width = .SlideWidth
         Height = .SlideHeight
      End With
      MsgBox "幻灯片的宽度是： " & (Width / 72) & "英寸，高度是： " _
         & (Height / 72) & "英寸。"
   End Sub

在阅读下面的内容之前，您应当具备下面的一些知识：

（1）基础的数学能力
（2）基础的VBA语言能力
（3）基本的算法能力

当您有了上面的基础知识之后，您就可以开始下面神奇的代码之旅了。

代码段一：绘正叶图

Sub 绘正叶图()
Dim r, x, y, i As Double
Dim cx, cy
Const PI = 3.1415926
For i = 0 To 6.3 Step 0.1
    r = 4 * Cos(2 * i)
    x = r * Cos(i)
    y = r * Sin(i)
    If i = 0 Then
        cx = 320 + x * 50
        cy = 240 - y * 50
        'ActivePresentation.SlideShowWindow.View.DrawLine cx, cy, 320 + x * 50, 240 - y * 50
    Else
        ActivePresentation.SlideShowWindow.View.DrawLine cx, cy, 320 + x * 50, 240 - y * 50
    cx = 320 + x * 50
    cy = 240 - y * 50
    End If
Next i
End Sub

代码二：绘钻石

Sub 绘钻石()
Dim x(50), y(50), Xc, Yc, tt, n, r, i, j
    Xc = 320
    Yc = 240
    r = 200
    n = 21
    tt = 2 * 3.14159 / n
    For i = 0 To n - 1
        x(i) = Xc + r * Cos(i * tt)
        y(i) = Yc - r * Sin(i * tt)
    Next i
    For i = 0 To n - 2
        For j = i + 1 To n - 1
            ActivePresentation.SlideShowWindow.View.DrawLine x(i), y(i), x(j), y(j)
        Next j
    Next i
End Sub

代码三：绘星形

Sub 绘星形()
    a = 100
    b = 10
    x = a
    y = a
    For i = 0 To 10
        star x, y
        x = x + b
        y = y - b
    Next i
    x = a
    y = a
    For i = 0 To 10
        star x, y
        x = x - b
        y = y + b
    Next i
End Sub
Private Sub star(x, y)
    ActivePresentation.SlideShowWindow.View.DrawLine 320, 200 - y, 320 - x, 200
    ActivePresentation.SlideShowWindow.View.DrawLine 320 - x, 200, 320, 200 + y
    ActivePresentation.SlideShowWindow.View.DrawLine 320, 200 + y, 320 + x, 200
    ActivePresentation.SlideShowWindow.View.DrawLine 320 + x, 200, 320, 200 - y
End Sub

 代码四：绘树形图

Sub 绘树形图()
    a = 3.14 / 15#
    th = 3.14 / 12#
    '绘出树干
    ActivePresentation.SlideShowWindow.View.DrawLine 150, 400, 450, 400
    ActivePresentation.SlideShowWindow.View.DrawLine 285, 400, 300, 180
    ActivePresentation.SlideShowWindow.View.DrawLine 300, 180, 315, 400
    '用随机函数Rnd绘制树叶
    For i = 0 To 99
        Xc = 180 + Rnd * 200
        Yc = 100 + Rnd * 180
        For j = 0 To 12
            x = Xc + 20 * Cos(j * a + th)
            y = Yc - 20 * Sin(j * a + th)
            ActivePresentation.SlideShowWindow.View.DrawLine Xc, Yc, x, y
        Next j
    Next i
End Sub

代码五：绘漂亮像框

Sub 绘漂亮像框()
    Const PI = 3.1415926
    Dim px, py, x, y, r, l, nn, i, n As Integer
    Dim x1(121), x2(121), y1(121), y2(121), cx, cy As Double
    Dim a As Double
    'PictDraw.Cls
    r = 35
    n = -1
    nn = 35
    i = 1
    For a = 0 To 2 * PI Step PI / 60
          
        x1(i) = CInt((1.1 * (r / 5 * Sin(8 * a) + r * Sin(2 * a)) * Cos(a)))
        y1(i) = CInt((0.85 * (r / 5 * Sin(8 * a) + r * Sin(2 * a)) * Sin(a)))
        x2(i) = CInt(((r / 5 * Sin(6 * a) + r * Sin(2 * a)) * Cos(a)))
        y2(i) = CInt(((r / 5 * Sin(6 * a) + r * Sin(2 * a)) * Sin(a)))
        i = i + 1
    Next a
    For px = 120 To 540 Step 60
        For py = 50 To 350 Step 60
            n = n + 1
            If px = 120 Or px = 540 Or py = 50 Or py = 350 Then
                For i = 1 To 121
                    x = (x2(i) - x1(i)) / nn * n + x1(i)
                    y = (y2(i) - y1(i)) / nn * n + y1(i)
                    x = (x + px) / 2
                    y = (y + py) / 2
                    If i = 1 Then
                        cx = x
                        cy = y
                    Else
                        ActivePresentation.SlideShowWindow.View.DrawLine cx, cy, x, y
                cx = x: cy = y
                    End If
                Next i
            End If
        Next py
    Next px
End Sub

1.  Sub CheckEffType()
2. Dim i As Integer
3. With ActivePresentation.Slides(1).TimeLine
4. For i = 1 To .MainSequence.Count
5. Set oeff = .MainSequence(i)
6. If oeff.EffectType < 53 And oeff.Exit = False Then strtype = "进入"
7. If oeff.EffectType < 53 And oeff.Exit = True Then strtype = "退出"
8. If oeff.EffectType > 53 And oeff.Effect.Type <82  Then strtype = "强调"
9. If oeff.EffectType > 86 And oeff.Effect.Type <149  Then strtype = "路径"
10. MsgBox oeff.DisplayName & " (" & strtype & ")"
11. Next
12. End With
13. End Sub

下面的代码用于提取嵌入到PPT中的声音并把它保存为 一个文件，SoundFormat对象在PPT对象模型中属于隐藏对象。

1. Sub ExtractWavFile()
2. Dim oShp As Shape
3. Set oShp = ActiveWindow.Selection.ShapeRange.Item(1)
4. With oShp
5. If .Type = msoMedia Then
6. If .MediaType = ppMediaTypeSound Then
7. If Dir(.SoundFormat.SourceFullName) <> "" Then
8. If MsgBox("Overwrite the original file?", _
9. vbQuestion + vbYesNo, "File already exists") = vbYes Then
10. .SoundFormat.Export .SoundFormat.SourceFullName
11. End If
12. End If
13. End If
14. End If
15. End With
16. End Sub