VBA 无法将特定工作表上的图表复制到 PowerPoint

Question

我有多张图表，但我只想从 "Calculated Sheets" 复制图表，但我的代码失败了。如果我不输入 ("Calculated Sheets")，宏会复制所有图表。感谢您的帮助。

Dim ppt As PowerPoint.Application
Dim ppTPres As PowerPoint.Presentation
Dim pptSld As PowerPoint.Slide
Dim pptCL As PowerPoint.CustomLayout
Dim pptShp As PowerPoint.Shape

Dim chtt As Chart
Dim ws As Worksheet
Dim i As Long

'Optimise execution of code
Application.ScreenUpdating = False

'Get the PowerPoint Application object:
Set ppt = CreateObject("PowerPoint.Application")
ppt.Visible = msoTrue
Set ppTPres = ppt.Presentations.Add

'Get a Custom Layout:
For Each pptCL In ppTPres.SlideMaster.CustomLayouts
    If pptCL.Name = "Title and Content" Then Exit For
Next pptCL

For Each ws In ActiveWorkbook.Worksheets("Calculated Values")
    For i = 1 To ws.ChartObjects.Count
        Set pptSld = ppTPres.Slides.AddSlide(ppTPres.Slides.Count + 1, pptCL)
        pptSld.Select

        For Each pptShp In pptSld.Shapes.Placeholders
            If pptShp.PlaceholderFormat.Type = ppPlaceholderObject Then Exit For
        Next pptShp

        Set chtt = ws.ChartObjects(i).Chart
        chtt.ChartArea.Copy
        ppt.Activate
        pptShp.Select
        ppt.Windows(1).View.Paste

          Next i
           Next ws

Answer 1

I would like to copy charts from "Calculated Sheets" only

如果您只需要来自特定 sheet 的图表，那么为什么循环 For Each ws In ActiveWorkbook

直接使用作品sheet。去掉上面的for循环。

Set ws = ThisWorkbook.Worksheets("Calculated Values")

For i = 1 To ws.ChartObjects.Count
    '
    '~~> Rest of your code
    '
Next i

VBA 无法将特定工作表上的图表复制到 PowerPoint

VBA Unable to copy chart on specific worksheet to PowerPoint

excel

charts

powerpoint

vba