[發問] 請問各位前輩關於將excel 圖表放置到ppt檔中(開啟)問題new

不好意思、請前輩們幫忙一下：
以下程式主要為將外部資料中的excel圖檔放置到指定地點的ppt檔中並新增幻燈片，
但小弟嘗試過卡住的問題點好像在於[Set wb(2) = Workbooks.Open(Worksheets("路徑區").Cells(3, 3) & "\" & Worksheets("路徑區").Cells(3, 2))]，
這一個excel開啟後就會出現{陣列索引超出範圍}，能不能請幫忙小弟看一下以下的程式碼需要再加什麼下去嗎？

附件：

PPT測試1.rar (39.92 KB)

縮寫程式碼： (附件為其它動作的程式、但似乎不影響問題點)

Sub excel外部資料製成ppt檔()

Dim wb(1 To 2) As Workbook, SN As String, SNN As Integer
      Dim Customer As String '料號的變數名稱
'問題點=================================
      Set wb(1) = ThisWorkbook
Set wb(2) = Workbooks.Open(Worksheets("路徑區").Cells(3, 3) & "\" & Worksheets("路徑區").Cells(3, 2))
'問題點=================================

'For this example click References on the Tools Menu, and select the (在這個例子中單擊工具菜單上的引用，然後選擇)
'Microsoft Powerpoint 9.0 object libraries.
Dim Ppt As Object, pres As Object

Dim SlideTitle As String


'Create a Microsoft PowerPoint session(創建一個Microsoft PowerPoint演示會議)
Set Ppt = CreateObject("powerpoint.application")

'Make PowerPoint visible(讓PowerPoint中可見)
Ppt.Visible = True
'Activate PowerPoint (啟動PowerPoint中)
AppActivate Ppt.Name
'Open a new document in Microsoft PowerPoint(打開Microsoft PowerPoint中一個新的文檔)
' Set pres = Ppt.Presentations.Add
Set pres = Ppt.Presentations.Open(Worksheets("路徑區").Cells(2, 3) & "\" & Worksheets("路徑區").Cells(2, 2)) '開啟ppt檔的路徑

      Dim activeSlide As PowerPoint.Slide
      Dim cht As Excel.ChartObject

'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
'(通過在每個排行榜中的Excel工作表，並循環將它們粘貼到PowerPoint中)

cd = 1 '設定為需更新的資料初始欄位

Do
      cd = cd + 1

      Customer = wb(1).Worksheets("分頁清單").Cells(cd, 1).Value

For Each cht In wb(2).Worksheets(Customer).ChartObjects

      '測試中----------------------------------


'       'Add a new slide where we will paste the chart(添加新的幻燈片，我們將粘貼圖表)
'       'ppLayout型態有..ppLayoutTitleOnly、ppLayoutText、ppLayoutText、ppLayoutChart、ppLayoutTitle(畫面最前主頁封面)
'
         Ppt.ActivePresentation.Slides.Add Ppt.ActivePresentation.Slides.Count + 1, ppLayoutTitleOnly
         Ppt.ActiveWindow.View.GotoSlide Ppt.ActivePresentation.Slides.Count
         Set activeSlide = Ppt.ActivePresentation.Slides(Ppt.ActivePresentation.Slides.Count)

      Next

   Loop Until cd >= wb(1).Worksheets("分頁清單").[a65536].End(3).Row



AppActivate ("Microsoft PowerPoint")
Set activeSlide = Nothing
Set Ppt = Nothing
'test-----------------------------------------------------------

Set pres = Nothing

   wb(2).Close True

Set wb(1) = Nothing
Set wb(2) = Nothing

樓主熱帖

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

2^#

發表於 2015-4-22 10:31 | 只看該作者

本帖最後由 stillfish00 於 2015-4-22 10:33 編輯

回復 1# ii31sakura
按偵錯是出現在更下面的地方。

Set pres = Ppt.Presentations.Open(wb(1).Worksheets("路徑區").Cells(2, 3) & "\" & wb(1).Worksheets("路徑區").Cells(2, 2)) '開啟ppt檔的路徑

表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

ii31sakura