我想要將下圖中的資料來源裡的一個表格內容（10列 X 3欄），其中每一列有三個儲存格內容，分別要對應到10張投影片裡每一張投影片的三個文字方塊。
以下是資料來源，是在 Excel 的一個表格內容。
其中：
表格中的第1欄內容對應到PowrePoint投影片中的最下層文字方塊（Name）：學校名稱
表格中的第2欄內容對應到PowrePoint投影片中的中間層文字方塊（Title）：課程名稱
表格中的第3欄內容對應到PowrePoint投影片中的最上層文字方塊（Content）：課程內容
我求助於 ChatGPT 給我 VBA 程式：
指令：我要將一個三欄多列的表格內容，轉換至現存PowerPoint簡報每張投影片的三個文字方塊中？其中，每一列的三個欄位內容，對應到每一張投影片的三個文字方塊。 請提供我VBA程式碼。
結果如下：（先複製這些程式碼）
準備工作：
1. 開啟 PowerPoint，並準備好 10 張投影片。（本例的 Excel 表格中有 10 列）
注意：不要關閉 PowerPoint 檔案。
2. 在 Excel 檔案中選取「開發人員」，再開啟 Visual Basic。
3. 選取「插入／模組」。
4. 將程式碼貼在這個程式區域中。
5. 本例只要在程式碼中修改 Excel 工作表名稱即可。
6. 點選：執行。
一瞬間，PowerPoint 投影片裡的三個文字方塊，即依 Excel 表格三個欄位內容對應填入了！
所有內容一次完成。
在此附上程式碼：
Sub FillPowerPointTextBoxes()
Dim pptApp As Object
Dim pptPresentation As Object
Dim pptSlide As Object
Dim ws As Worksheet
Dim rng As Range
Dim row As Range
Dim i As Integer
Dim textBox1 As Object
Dim textBox2 As Object
Dim textBox3 As Object
' 設定Excel中的表格範圍
Set ws = ThisWorkbook.Sheets("資料") ' 更改為你的工作表名稱
Set rng = ws.Range("A2:C" & ws.Cells(ws.Rows.Count, "A").End(xlUp).row) ' 假設數據從A2開始
' 打開已存在的PowerPoint
On Error Resume Next
Set pptApp = GetObject(Class:="PowerPoint.Application")
If pptApp Is Nothing Then
Set pptApp = CreateObject(Class:="PowerPoint.Application")
End If
pptApp.Visible = True
' 假設已經打開了你的PowerPoint簡報
Set pptPresentation = pptApp.ActivePresentation
' 遍歷表格的每一列，並將內容填入PowerPoint
i = 1
For Each row In rng.Rows
' 確保有足夠的投影片來填充內容
If i <= pptPresentation.Slides.Count Then
Set pptSlide = pptPresentation.Slides(i) ' 將每一列數據對應到每張投影片
' 假設每張投影片上有三個文字方塊，依次填入表格中的三個欄位
Set textBox1 = pptSlide.Shapes(1) ' 第一個文字方塊
textBox1.TextFrame.TextRange.Text = row.Cells(1, 1).Value
Set textBox2 = pptSlide.Shapes(2) ' 第二個文字方塊
textBox2.TextFrame.TextRange.Text = row.Cells(1, 2).Value
Set textBox3 = pptSlide.Shapes(3) ' 第三個文字方塊
textBox3.TextFrame.TextRange.Text = row.Cells(1, 3).Value
End If
i = i + 1
Next row
MsgBox "內容填充完成！"
End Sub
留言列表