VBA를 사용하여 PowerPoint에서 제목 설정

Question

나는 매크로가있어서 Excel의 일부 데이터를 PowerPoint 프레젠테이션으로 내보내려고합니다. 파워 포인트에서 Excel의 제목을 일부 타이틀로 지정해야합니다. 여기 내 코드입니다 :

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