使用VBA在PowerPoint中設置標題

Question

我是新的宏，我試圖導出一些數據從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，我需要插入一個「示例」的稱號，但它說，「myTitle」對象不存在。在第二種情況下，我需要把電池作爲標題，但我不知道如何使用功能

ppSlide2.Shapes.PasteSpecial（數據類型：= ppPasteText）

謝謝您的幫助。

Answer 1

對於第一個問題，您使用的是Layout:=ppLayoutBlank哪個沒有不是有一個Title的形狀。您應該使用包含標題形狀的佈局。

我將使用ppLayoutTitleOnly但您可以使用任何包含標題形狀的佈局。

對於第二種情況，讓我們將Cell的值存儲爲字符串變量，然後使用它寫入幻燈片的標題形狀。沒有必要使用Copy方法。我也會建議將你的聲明移動到你的代碼的頂部 - VBA不會有條件地處理DIM語句，所以沒有什麼理由將它們放到你的循環中，並且只會讓你更難在後面找到需要修改一些東西。

注意此代碼是不完整的，因此尚未經過測試。

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