将图表从Excel复制到powerpoint时更改幻灯片标题

时间:2014-05-02 12:15:38

标签: excel vba powerpoint

我编写了一个代码,可以将图表从excel工作簿动态复制到powerpoint演示文稿。 我现在要做的是动态更改每张幻灯片的幻灯片标题。 这是代码的片段:

PPApp.ActivePresentation.Slides.Add PPApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank
        PPApp.ActiveWindow.View.GotoSlide PPApp.ActivePresentation.Slides.Count
        Sheets("sheet1").Range("V1").Value = h
        Sheets("sheet1").Range("V11").Value = j
        Sheets("sheet1").Range("V22").Value = k
        Sheets("sheet1").Select
        ActiveSheet.ChartObjects("Chart 5").Activate
        ActiveSheet.ChartObjects("Chart 5").CopyPicture
        PPApp.ActiveWindow.View.Paste
        eachslideheader = Range("v2").Text & "my chart"
       PPApp.ActivePresentation.Slides.ppLayoutTitle.Add

PPApp.ActivePresentation.Slides.pplayouTitle.TextFrame.TextRange.Text = eachslideheader

此代码在插入标题时出错我无法弄明白。我该如何处理。请帮助

1 个答案:

答案 0 :(得分:0)

' Assuming you're running this from w/in Excel ...
Dim oSl as Object    

' Get a reference to the added slide object to make things simpler later
' Make the new slide a TitleOnly layout so that it automatically gets a title
' placeholder:
Set oSl = PPApp.ActivePresentation.Slides.Add PPApp.ActivePresentation.Slides.Count + 1, _
      ppLayoutTitleOnly 
    ' ppLayoutTitleOnly = 11

            PPApp.ActiveWindow.View.GotoSlide PPApp.ActivePresentation.Slides.Count

            Sheets("sheet1").Range("V1").Value = h
            Sheets("sheet1").Range("V11").Value = j
            Sheets("sheet1").Range("V22").Value = k
            Sheets("sheet1").Select
            ActiveSheet.ChartObjects("Chart 5").Activate
            ActiveSheet.ChartObjects("Chart 5").CopyPicture
            PPApp.ActiveWindow.View.Paste
            eachslideheader = Range("v2").Text & "my chart"

'           PPApp.ActivePresentation.Slides.ppLayoutTitle.Add

'    PPApp.ActivePresentation.Slides.pplayouTitle.TextFrame.TextRange.Text = eachslideheader

oSl.Shapes.Title.Textframe.TextRange.Text = eachslideheader