曾经有一个问题，一直困扰我很久。由于工作的需要，经常需要把access数据表的内容,制作成powerpoint幻灯片，常常在做大量的单调的重复的简单劳动。作为一个程序设计的爱好者，最不愿意做的就是这种简单机械的事情。

那么，如何根据数据表中数据,生成powerpoint幻灯片呢？

我的具体要求是这样的:
   每个记录 对应一张幻灯片;
   每个字段的内容,对应一个文本框;
  最好,相同字段对应的文本框,在每张幻灯片中的位置和格式是相同的.

大体过程是这样的：

第一步：先用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 ("生成结束! 用时  " & str(t2 - t1))
end sub

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
    for each s in newslide.shapes
        debug.print s.id, s.name, s.textframe.textrange.text
    next
    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