使用VBA在PowerPoint中设置标题

我是新的macros，我试图导出一些数据从Excel到PowerPoint演示文稿。 我需要把一些Excel中的单元格作为PowerPoint中的标题。 这是我的代码：

Sub CrearPresentacion2() 'Iniciar las variables Dim rng As Excel.Range Dim PowerPointApp As PowerPoint.Application Dim myPresentation As PowerPoint.Presentation Dim myShapeRange As PowerPoint.ShapeRange 'Pedir al usuario un rango de celdas Set rng = Application.InputBox("Seleccione el Rango para hacer Presentación", Title:="Seleccionar Rango", Type:=8) On Error Resume Next 'Hacer PowerPoint visible PowerPointApp.Visible = True PowerPointApp.Activate 'Crear Nueva Presentacion Set myPresentation = PowerPointApp.Presentations.Add 'Ciclo para copiar cada celda en una diapositiva For Each Cell In rng.Cells Cell.Select Selection.Copy Dim ppSlide2 As PowerPoint.Slide Dim x As Integer x = myPresentation.Slides.Count + 1 If x = 1 Then Set ppSlide2 = myPresentation.Slides.Add(Index:=x, Layout:=ppLayoutBlank) PowerPointApp.ActivePresentation.Slides(x).Select PowerPointApp.ActiveWindow.Selection.SlideRange.Select Set myShapeRange = ppSlide2.Shapes.PasteSpecial(DataType:=ppPasteText) Dim Header1 As String Header1 = "Example" Set myTitle = ppSlide2.Shapes.Title myTitle.TextFrame.TextRange.Characters.Text = Header1 ElseIf x = 2 Then Set ppSlide2 = myPresentation.Slides.Add(Index:=x, Layout:=ppLayoutBlank) PowerPointApp.ActivePresentation.Slides(x).Select PowerPointApp.ActiveWindow.Selection.SlideRange.Select Set myShapeRange = ppSlide2.Shapes.PasteSpecial(DataType:=ppPasteText) Else Set ppSlide2 = myPresentation.Slides.Add(Index:=x, Layout:=ppLayoutText) PowerPointApp.ActivePresentation.Slides(x).Select PowerPointApp.ActiveWindow.Selection.SlideRange.Select Set myShapeRange = ppSlide2.Shapes.PasteSpecial(DataType:=ppPasteText) End If Next Cell CutCopyMode = False 

当计数器等于1时，我需要插入一个“Example”标题，但是它说“myTitle”对象不存在。 在第二种情况下，我需要把单元格作为Title，但是我不知道如何使用这个函数

ppSlide2.Shapes.PasteSpecial（数据types：= ppPasteText）

谢谢你的帮助。

Answer 1

对于第一个问题，您正在使用Layout:=ppLayoutBlank ，它没有 Title形状。 您应该使用包含标题形状的布局。

我将使用ppLayoutTitleOnly但可以使用包含标题形状的任何布局。

对于第二种情况，让我们将Cell的值存储为stringvariables，然后使用它写入幻灯片的标题形状。 没有必要使用Copy方法。 我也会build议把你的声明移动到你的代码的最前面–VBA不会有条件地处理DIM语句，所以没有什么理由把它们放在你的循环中，而且如果你稍后再找需要修改一些东西。

请注意，此代码不完整，因此尚未经过testing。

 Dim titleText As String Dim ppSlide2 As PowerPoint.Slide Dim x As Integer Dim Header1 As String PowerPointApp.Visible = True PowerPointApp.Activate 'Crear Nueva Presentacion Set myPresentation = PowerPointApp.Presentations.Add 'Ciclo para copiar cada celda en una diapositiva For Each Cell In rng.Cells titleText = Cell.Value x = myPresentation.Slides.Count + 1 If x = 1 Then Set ppSlide2 = myPresentation.Slides.Add(Index:=x, Layout:=ppLayoutTitleOnly) PowerPointApp.ActivePresentation.Slides(x).Select PowerPointApp.ActiveWindow.Selection.SlideRange.Select Set myShapeRange = ppSlide2.Shapes.PasteSpecial(DataType:=ppPasteText) Header1 = "Example" Set myTitle = ppSlide2.Shapes.Title myTitle.TextFrame.TextRange.Characters.Text = Header1 ElseIf x = 2 Then Set ppSlide2 = myPresentation.Slides.Add(Index:=x, Layout:=ppLayoutTitleOnly) PowerPointApp.ActivePresentation.Slides(x).Select PowerPointApp.ActiveWindow.Selection.SlideRange.Select ' not sure what this next line does so I omit it 'Set myShapeRange = ppSlide2.Shapes.PasteSpecial(DataType:=ppPasteText) Set myTitle = ppSlide2.Shapes.Title '## Insert the titleText from Cell variable in this slide's Title shape: myTitle.TextFrame.TextRange.Characters.Text = titleText Else Set ppSlide2 = myPresentation.Slides.Add(Index:=x, Layout:=ppLayoutText) PowerPointApp.ActivePresentation.Slides(x).Select PowerPointApp.ActiveWindow.Selection.SlideRange.Select Set myShapeRange = ppSlide2.Shapes.PasteSpecial(DataType:=ppPasteText) End If Next Cell CutCopyMode = False