曾經有一個問題，一直困擾我很久。由於工作的需要，經常需要把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
