none
Exportar imagem do Excel para powerpoint e ajustar em cima de um retângulo. RRS feed

  • Pergunta

  • Eu desejo exportar como imagem para o PowerPoint os dados que tenho no Excel. Após essas imagens serem exportadas, preciso que fiquem ajustadas no slide em cima de um retângulo.

    Segue abaixo o comando que estou usando para colar a imagem no PowerPoint.

    Sub Mapas_PPT()

    Workbooks.Open Filename:="D:\Excel Macro\Osasco\Output_Report_Tim.xlsx"

    'Declaração dos objetos do Powerpoint

    ' Não esquecer de fazer referência  (Tools | References) to the Microsoft PowerPoint nn.nn Object Library

    Dim pptApp As PowerPoint.Application
    Dim pptPres As PowerPoint.Presentation
    Dim pptSld As PowerPoint.Slide

    'Sessão de referência do Powerpoint

    Set pptApp = CreateObject("PowerPoint.Application")
    pptApp.Visible = msoTrue

    'Abrir ppt existente

    pptApp.Visible = True
    pptApp.Presentations.Open "D:\Excel Macro\Template_Tim_v08_Clear_DT.pptx"
    Set pptPres = pptApp.ActivePresentation
    pptApp.ActiveWindow.ViewType = ppViewSlide

    ' Selecionar Gráfico a ser copiada para o PowerPoint:
    '=========================================================================================
    'Setar Slide Grafico
    Set pptSld = pptPres.Slides(50)
    pptApp.ActiveWindow.View.GotoSlide pptSld.SlideIndex

    Sheets("Hist_Table").Select

    Range("U2:AF13").Select
    Selection.Copy
    Application.CutCopyMode = False
    Selection.Copy

    Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

    pptSld.Shapes.Paste.Select

    pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    pptApp.ActiveWindow.Selection.ShapeRange.Item(1).ScaleHeight 1, msoCTrue, msoScaleFromMiddle
    segunda-feira, 28 de janeiro de 2019 18:22