Bom dia a todos.

Tenho um planilha que gera relatórios em powerpoint, com a mudança do office para o 2016, acabou desconfigurando os slides.

O tamanho do slide mudou, daí sempre tenho que mudar manualmente e alterar os slides para o novo tamanho.

Uso o tamanho padrão 4:3

Alguém passou por isso aí?
Alguém tem alguma ideia de como faço para mudar o tamanho do slide ao ser criado o arquivo?

Desde já, meu muito obrigado

Segue o meu código que gera.

Sub gerar_ppt() 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = False
    Dim contPrincipal As Integer
    Dim pptConn As Object
    Dim slideNumber As Integer
    Dim varShape As ShapeRange
    Dim planilhaFonte, areaFonte As String
    Dim prompt As String
    Dim escala As Double
    Dim ComandoSQL As String
    Dim id As String
    
    Sheets("Plan1").Select
        
    Application.ScreenUpdating = False

    
On Error GoTo ErroPadrao
    Set pptConn = CreateObject("PowerPoint.Application")
    pptConn.Presentations.Add msoTrue
    Call LB_Atualizaze
    x = ComboBox1.ListCount
    y = 0
    Call Desbloqueia_Edição_Marcos
    ActiveSheet.Shapes.Range(Array("Group 24")).Left = 16
    ActiveSheet.Shapes.Range(Array("Group 24")).Top = 40
    While y < x

        ComboBox1.ListIndex = y
        id = ComboBox1.Text
        ComandoSQL = "select * from TB_RGM where TAP like '" & id & "'" & " ORDER BY FASE, STATUS, TAP"
        Call Conectar
        Set consulta = banco.OpenRecordset(ComandoSQL)
        
        If consulta("COD") <> " " Then
            
         Range("h4").Value = consulta("BL_FUT")
         Range("h5").Value = consulta("PR_FUT")
         Range("h6").Value = consulta("RL_FUT")
         Range("h7").Value = consulta("TD_FUT")
        

    
            
        Application.ScreenUpdating = True
        
        pptConn.Visible = msoTrue
    
        slideNumber = y + 1
        
        planilhaFonte = "Plan1"
        areaFonte = "H4:Y45"
        'escala = 0.48
        
        '// COPIA O RANGE
        Sheets(planilhaFonte).Select
        Sheets(planilhaFonte).Range(areaFonte).Select
        Selection.Copy
        '// COLA
        slideNumber = pptConn.ActivePresentation.Slides.Count + 1
        pptConn.ActivePresentation.Slides.Add Index:=slideNumber, Layout:=ppLayoutBlank
        pptConn.ActivePresentation.Slides(slideNumber).Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
        pptConn.ActivePresentation.Slides(slideNumber).Shapes(1).LockAspectRatio = True
        pptConn.ActivePresentation.Slides(slideNumber).Shapes(1).Width = 718
        pptConn.ActivePresentation.Slides(slideNumber).Shapes(1).Top = 1
        pptConn.ActivePresentation.Slides(slideNumber).Shapes(1).Left = 0.9
        
        ActiveSheet.Range("H8").Select
        Application.CutCopyMode = False
        Application.ScreenUpdating = False
        y = y + 1
    Else
        y = y + 1
    End If
    
    Wend
    Call Limpa_Campos
    Sheets("Plan1").ComboBox1.Text = ""
    Sheets("Plan1").ComboBox2.Text = ""
    ActiveSheet.Shapes.Range(Array("Group 24")).Left = 240048
    ActiveSheet.Shapes.Range(Array("Group 24")).Top = 9
    
'///////////////////////////////////////////
On Error GoTo 0
        Application.CutCopyMode = False
        Call Bloqueia_Edição
        ActiveSheet.Shapes.Range(Array("Group 24")).Left = 240048
        ActiveSheet.Shapes.Range(Array("Group 24")).Top = 9
        'prompt = "Apresentação gerada com sucesso!"
        'MsgBox (prompt)
        Exit Sub
  
ErroPadrao:
    prompt = "Erro ao gerar a apresentação!"
    ActiveSheet.Shapes.Range(Array("Group 24")).Left = 240048
    ActiveSheet.Shapes.Range(Array("Group 24")).Top = 9
    MsgBox (prompt)
    Call Bloqueia_Edição
    Call LB_Atualiza
    Exit Sub
    Resume Next
    Application.CutCopyMode = False
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub