Question

以下代码采用excel中指定的范围，并将范围导入PowerPoint。我的努力是我试图为代码中的每张幻灯片添加幻灯片标题，但下面的语法不起作用（Header1 =＆＃34; test＆＃34;）。你能帮忙吗？在此先感谢!!

Sub export_to_powerpoint()
Dim PPAPP As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim SlideCount As Integer
Dim shptbl As Table
Set PPAPP = New PowerPoint.Application
Dim cht As Excel.ChartObject
Dim Header1 As String

PPAPP.Visible = True



'create new ppt:

Set PPPres = PPAPP.Presentations.Add


For ii = 1 To 10
PPPres.Slides.Add PPPres.Slides.Count + 1, ppLayoutTitleOnly



Next ii

PasteRng PPPres, 1, Range("A2:S24")
PPSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text

Header1 = "test" 'Titel on the first slide

PPAPP.ActiveWindow.Selection.ShapeRange.Left = 5
PPAPP.ActiveWindow.Selection.ShapeRange.Top = 100

PPAPP.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.8, msoTrue
PPAPP.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.7, msoTrue

PPAPP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPAPP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True




PasteRng PPPres, 2, Range("A25:S47")

PPAPP.ActiveWindow.Selection.ShapeRange.Left = 5
PPAPP.ActiveWindow.Selection.ShapeRange.Top = 100

PPAPP.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.8, msoTrue
PPAPP.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.7, msoTrue

PPAPP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPAPP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

PasteRng PPPres, 3, Range("v2:am24")

'Adjust the positioning of the Chart on Powerpoint Slide
PPAPP.ActiveWindow.Selection.ShapeRange.Left = 5
PPAPP.ActiveWindow.Selection.ShapeRange.Top = 100

PPAPP.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.8, msoTrue
PPAPP.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.7, msoTrue

PPAPP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPAPP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True




Set PPSlide = Nothing
Set PPPres = Nothing
Set PPAPP = Nothing
End Sub

Sub PasteRng(Pres, SlideNo, Rng As Range)
Rng.Copy ' copy the range
Pres.Application.ActiveWindow.View.GotoSlide SlideNo 'PPSlide.SlideIndex ' activate the slide no
Pres.Application.ActiveWindow.View.PasteSpecial ppPasteOLEObject, msoFalse ' paste using pastespecial method
End Sub

Answer 1

您的代码有效。当你

时，它正在按照你的要求去做（可能与你的预期有所不同......）

Dim Header1 as String

您创建一个能够保存字符串数据的字符串变量。

然后你分配给它：

Header1 = "test" 'Titel on the first slide

您的代码中没有任何地方甚至尝试使用此字符串写入幻灯片的标题。你需要将它分配给幻灯片的标题对象。

Header1 = "test" 

Dim sldTitle as Object
If Not ppSlide.Shapes.HasTitle Then

    'If there is no title object then assume the slideLayout does not permit one
    ' so do nothing.
Else:
    Set myTitle = ppSlide.Shapes.Title
    'Assign the title text:
    myTitle.TextFrame.TextRange.Characters.Text = Header1
End If

这对你来说很方便：

http://msdn.microsoft.com/en-us/library/office/ff743835(v=office.14).aspx

如何添加powerpoint幻灯片标题？

1 个答案: