由于工作的需要,经常需要把access数据表的内容,制作成powerpoint幻灯片,常常在做大量的单调的重复的简单劳动。作为一个程序设计的爱好者,最不愿意做的就是这种简单机械的事情。第一步:先用powerpoint新建一张幻灯片,添加五个文本框,分别用 于显示数据表中五个字段的值;再添加其它有关文本,并设置好各对象的格式及动画。 第二步:在access数据中,建立以下程序:
曾经有一个问题,一直困扰我很久。由于工作的需要,经常需要把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 = “a:” & trim(rs(“xxone”)) & chr(13)
s4 = s4 & “b:” & trim(rs(“xxtwo”)) & chr(13)
s4 = s4 & “c:” & trim(rs(“xxthr”)) & chr(13)
s4 = s4 & “d:” & 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