每個記錄 對應一張幻燈片;
  每個字段的內容,對應一個文本框;
  最好,相同字段對應的文本框,在每張幻燈片中的位置和格式是相同的.
大體過程是這樣的：
第一步：先用Powerpoint新建一張幻燈片，添加五個文本框，分別用 于顯示數據表中五個字段的值；再添加其它有關文本，并設置好各對象的格式及動畫。
第二步：在Access數據中，建立以下程序：
Sub lPPTadd(sTH As String, sYM As String, sLR As String, sXH As String, sDA As String, sTX As String)
    '參數分別是:      題號,頁碼,內容,選項,答案,題型
    '使用復制的方法來添加幻燈片
    Set newSlide = ActivePresentation.Slides(1).Duplicate
    With newSlide
        .Shapes("Rectangle 2").TextFrame.TextRange.Text = Trim(sTH)  '題號
        .Shapes("Rectangle 3").TextFrame.TextRange.Text = Trim(sLR)  '內容
        .Shapes("Rectangle 6").TextFrame.TextRange.Text = Trim(sYM)  '頁碼
        .Shapes("Rectangle 7").TextFrame.TextRange.Text = Trim(sDA)  '答案
        .Shapes("Text Box 8").TextFrame.TextRange.Text = Trim(sTX)  '題型
        .Shapes("Rectangle 9").TextFrame.TextRange.Text = Trim(sXH)  '選項
    End With
End Sub
Sub ReadDb()
    Dim s As String
    Dim sDB As String
    Dim lconn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    sDB = "F:\bq1.mdb"
    s = " Provider=Microsoft.Jet.OLEDB.4.0 "
    s = s & " Data Source= " & Trim(sDB)
    s = s & " ;Persist Security Info=False"
    lconn.Open s
    s = "SELECT * FROM 題庫 "
    rs.Open s, lconn, adOpenStatic, adLockReadOnly
    rs.MoveLast
    Dim i As Long, n As Long
    Dim s1 As String, s2 As String, s3 As String, s4 As String, s5 As String, s6 As String
   
    n = rs.RecordCount
    rs.MoveFirst
    i = 1
    If n > 0 Then
        Call lPPTdel
        Do While Not rs.EOF
            s1 = Trim(str(i))
            n = Val("" & rs("page"))
            s2 = IIf(n = 0, "", Trim(str(n)))
            s3 = Trim(rs("kttxt"))
            n = Val("" & rs("txcode"))
            If n = 0 Or n = 1 Then
                s4 = "Ａ：" & Trim(rs("xxone")) & Chr(13)
                s4 = s4 & "Ｂ：" & Trim(rs("xxtwo")) & Chr(13)
                s4 = s4 & "Ｃ：" & Trim(rs("xxthr")) & Chr(13)
                s4 = s4 & "Ｄ：" & Trim(rs("xxfou"))
                s5 = "（" + IIf(rs("ISOKone") = 1, "A", "")
                s5 = s5 & IIf(rs("ISOKtwo") = 1, "B", "")
                s5 = s5 & IIf(rs("ISOKthr") = 1, "C", "")
                s5 = s5 & IIf(rs("ISOKfou") = 1, "D", "") & "）"
            End If
            Select Case n
                Case 0
                    s6 = "多選題"
                Case 1
                    s6 = "單選題"
                Case 2
                    s4 = ""
                    s5 = "（" + IIf(rs("ISOK") = 1, "√", "×") & "）"
                    s6 = "判斷題"
                Case Else
                    s4 = ""
                    s5 = ""
                    s6 = ""
            End Select
            Call lPPTadd(s1, s2, s3, s4, s5, s6)
            i = i + 1
            rs.MoveNext
        Loop
    End If
    t2 = Timer
    MsgBox ("生成結束!