携自动功能之利，通过access使用PowerPoint演示文稿

来源:AccessHome 点击数:6244 　 | 收藏 | 复制

时　间:2009-03-03 10:45:05
作　者:AccessHome整理 ID：563 城市：上海
摘　要:适用于：
Microsoft Office Access 2000 or later
Microsoft Office PowerPoint 2003

使用 Access 数据，从头创建 PowerPoint 幻灯演示文稿。此外，在 Access 窗体中显示并控制幻灯片放映。演练解决方案，并探索将示例扩展到自己的应用程序的方法。

正　文:

本文探讨两种在 Access 和 PowerPoint 之间的交互方法。第一个示例描述如何利用自动功能使用 Access 表的数据来创建 PowerPoint 演示文稿。第二个示例说明，同样利用自动功如何在 Access 窗体中显示和操纵现有的 PowerPoint 演示文稿。通过操纵受控应用程序的公开属性和方法并响应事件，自动功能使您能够从不同的应用程序来控制一个应用程序。

从 Access 数据创建 PowerPoint 演示文稿

本示例通过 Access 数据创建一个幻灯演示文稿。Recordset 对象由表中的数据创建。然后，使用记录集中的数据填充幻灯片。

要创建幻灯片，请执行以下步骤：

启动 Access 并打开任一数据库。
在“设计”视图中，创建以下带有所示控件的窗体，使其不依赖于任何表或查询：

Form: CreateFromAccessData

Caption: PowerPoint Demo

Command Button: cmdPowerPoint
- Name: cmdPowerPoint
- Caption: PowerPoint Example
- Width: 2"
在 View 菜单上，单击 Code。
在 Tools 菜单上，单击 References。
在 Available References 框中，单击 Microsoft PowerPoint 9.0 Object Library 和 Microsoft Office 9.0 Object Library。
单击 OK 关闭 References 对话框。
将下面的代码行添加到 General Declarations 部分：
```
Option Explicit
```

键入或粘贴以下过程：

Sub cmdPowerPoint_Click()
    Dim db As Database, rs As Recordset
    Dim ppObj As PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation
    
    On Error GoTo err_cmdOLEPowerPoint
    
    ' Open up a recordset on the Employees table.
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Employees", dbOpenDynaset)
    
    ' Open up an instance of Powerpoint.
    Set ppObj = New PowerPoint.Application
    Set ppPres = ppObj.Presentations.Add
    
    ' Setup the set of slides and populate them with data from the
    ' set of records.
    With ppPres
        While Not rs.EOF
            With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutTitle)
                .Shapes(1).TextFrame.TextRange.Text = "Hi!  Page " & rs.AbsolutePosition + 1
                .SlideShowTransition.EntryEffect = ppEffectFade
                With .Shapes(2).TextFrame.TextRange
                    .Text = CStr(rs.Fields("LastName").Value)
                    .Characters.Font.Color.RGB = RGB(255, 0, 255)
                    .Characters.Font.Shadow = True
                End With
                .Shapes(1).TextFrame.TextRange.Characters.Font.Size = 50
            End With
            rs.MoveNext
        Wend
    End With
    
    ' Run the show.
    ppPres.SlideShowSettings.Run
    
    Exit Sub
    
err_cmdOLEPowerPoint:
    MsgBox Err.Number & " " & Err.Description
End Sub

保存这个 PowerPointDemo 窗体，并在“窗体”视图中打开它。
单击 PowerPoint Example。

注意，该 PowerPoint 幻灯片放映在您的屏幕上创建并进行显示。单击鼠标，在幻灯片间移动。

利用自动功能在窗体中显示 PowerPoint 演示文稿

该示例为您说明如何在 Access 的窗体上显示 PowerPoint 中的幻灯片。该技术使用 Access 中的自动功能来打开 PowerPoint 演示文稿并链接至第一张幻灯片。通过更改 SourceItem 属性（使您能够链接至不同幻灯片），可查看其他幻灯片。

注要使用这项技术，计算机上必须安装有 PowerPoint 和 Access。还需要创建一个 PowerPoint 演示文稿 (.ppt)。在该过程中，用您自己文件的名称及路径替换以下文件名：
C:\Program Files\Microsoft Office\Office\Pptexample.ppt
作为提供的下载示例，其中包含一个示例演示文稿。

下面的示例创建一个窗体，该窗体具有一个未绑定的对象框控件和五个命令按钮，以链接至 PowerPoint 演示文稿并在其幻灯片之间移动。

要在窗体中显示 Microsoft PowerPoint 幻灯片，请遵循以下步骤：

在新的 Access 数据库中，在“设计”视图中创建一个窗体。
将以下五个控件添加至该窗体：

命令按钮
- Name: insertShow
- Caption: Get Presentation
- Enabled: Yes
命令按钮
- Name: frstSlide
- Caption: First Slide
- Enabled: No
命令按钮
- Name: nextSlide
- Caption: Next Slide
- Enabled: No
命令按钮
- Name: previousSlide
- Caption: Previous Slide
- Enabled: No
命令按钮
- Name: lastSlide
- Caption: Last Slide
- Enabled: No
向该窗体添加一个未绑定的对象框控件。在 Insert Object 框中，单击 Create New button，选择 Bitmap Image 作为对象类型，然后单击 OK。注意，该对象框在窗体上为一块空白空间。
显示未绑定对象框的属性表，然后设置属性（如下所示）：

未绑定对象框
- Name: pptFrame
- SizeMode: Zoom
- Enabled: Yes
- Locked: No
在 View 菜单上，单击 Code 打开窗体模块。

将以下代码添加到 General Declarations 部分：

Option Explicit

' Initialize variables.
Private mcolSlideIDs As Collection
Private mlngSlideIndex As Long

在 Object 列表中，单击 insertShow。在 Procedure 列表中，单击 Click，然后添加以下代码：

Private Sub insertShow_Click()
    On Error GoTo insertShow_Click_Error
    
    ' Open PowerPoint
    Dim strPowerPointFile As String
    Dim pptobj As PowerPoint.Application
    Set pptobj = New PowerPoint.Application
    pptobj.Visible = True
    pptobj.WindowState = ppWindowMinimized
    
    strPowerPointFile = CurrentProject.Path & "\Access2PowerPoint.ppt"
    
    ' Fill a collection with all Slide IDs.
    With pptobj.Presentations.Open(strPowerPointFile)
        Set mcolSlideIDs = New Collection
        Dim ppSlide As PowerPoint.Slide
        For Each ppSlide In .Slides
            mcolSlideIDs.Add ppSlide.SlideID
        Next
        .Close
    End With
    
    ' Close PowerPoint
    pptobj.Quit
    Set pptobj = Nothing

    ' Make object frame visible and enable "navigation" buttons.
    pptFrame.Visible = True
    frstSlide.Enabled = True
    lastSlide.Enabled = True
    nextSlide.Enabled = True
    previousSlide.Enabled = True

    ' Specify OLE Class, Type, SourceDoc, SourceItem and other properties.
    With pptFrame
        .Class = "Microsoft Powerpoint Slide"
        .OLETypeAllowed = acOLELinked
        .SourceDoc = strPowerPointFile
    End With
    SetSlide 1
    
    frstSlide.SetFocus
    insertShow.Enabled = False
    
    Exit Sub

insertShow_Click_Error:
    MsgBox Err.Number & " " & Err.Description
    Exit Sub
End Sub

在 Object 列表中，单击 frstSlide。在 Procedure 列表中，单击 Click，然后添加以下代码：
```
Private Sub frstSlide_Click()
    SetSlide 1
End Sub
```
在 Object 列表中，单击 lastSlide。在 Procedure 列表中，单击 Click，然后添加以下代码：
```
Private Sub lastSlide_Click()
    SetSlide mcolSlideIDs.Count
End Sub
```
在 Object 列表中，单击 nextSlide。在 Procedure 列表中，单击 Click，然后添加以下代码：
```
Private Sub nextSlide_Click()
    SetSlide mlngSlideIndex + 1
End Sub
```
在 Object 列表中，单击 previousSlide。在 Procedure 列表中，单击 Click，然后添加以下代码：
```
Private Sub previousSlide_Click()
    SetSlide mlngSlideIndex - 1
End Sub
```

添加以下过程：

Private Sub SetSlide(ByVal ID As Integer)
    On Error GoTo ErrorHandler
    
    Select Case ID
    Case Is > mcolSlideIDs.Count
        MsgBox "This is the last slide."
    Case 0
        MsgBox "This is the first slide."
    Case Else
        mlngSlideIndex = ID
        With pptFrame
            .SourceItem = mcolSlideIDs(mlngSlideIndex)
            .Action = acOLECreateLink
        End With
    End Select

    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " " & Err.Description
    Exit Sub
End Sub