- 帖子
- 43
- 主題
- 13
- 精華
- 0
- 積分
- 75
- 點名
- 0
- 作業系統
- windows 7
- 軟體版本
- office 2007
- 閱讀權限
- 20
- 註冊時間
- 2014-5-6
- 最後登錄
- 2019-6-17
|
[發問] 請問各位前輩關於將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 |
|