Results 1 to 1 of 1

Thread: Macro on PPT

  1. #1
    Join Date
    Jul 2015
    Posts
    7

    Unanswered: Macro on PPT

    Hello all.

    I need a macro to export a cell which will be my title.

    For example: Arsenal (History). So, I want a button and export this text.

    And I made a quick formula to always change the team and keep the "(History)".

    So, will be always on E3.

    So, just import E3 for the PPT.


    I'm using this code:


    Sub ExportarPPTX2()

    'Referenciando a Biblioteca Microsoft Powerpoint:
    '1. No ambiente de Desenvolvimento VBA: Menu / Tools
    '2. Click em Reference
    '3. Desça até encontrar Microsoft PowerPoint X.0 Object Library, selecione a opção e clique em OK

    Dim newPowerPoint As PowerPoint.Application 'Declarando as variáveis que serão usadas
    Dim newPresentation As PowerPoint.Presentation
    Dim activeSlide As PowerPoint.Slide
    Dim cht As Excel.ChartObject

    On Error Resume Next 'Procurando instâncias
    Set newPowerPoint = GetObject(, "PowerPoint.Application")
    On Error GoTo 0

    If newPowerPoint Is Nothing Then ' Check whether PowerPoint is running
    Set newPowerPoint = CreateObject("PowerPoint.Application") ' PowerPoint is not running, create new instance
    newPowerPoint.Visible = True ' For automation to work, PowerPoint must be visible
    End If
    On Error GoTo 0

    On Error Resume Next ' Reference presentation and slide

    If newPowerPoint.Windows.Count > 0 Then ' There is at least one presentation
    Set newPresentation = newPowerPoint.ActivePresentation ' Use existing presentation
    Set activeSlide = newPresentation.Slides _
    (newPowerPoint.ActiveWindow.Selection.SlideRange.S lideIndex) ' Use active slide
    Else
    Set newPresentation = newPowerPoint.Presentations.Add ' There are no presentations, Create new presentation
    Set activeSlide = newPresentation.Slides.Add(1, ppLayoutBlank) ' Add first slide
    End If
    On Error GoTo 0

    ' Some PowerPoint actions work best in normal slide view
    newPowerPoint.ActiveWindow.ViewType = ppViewNormal ' options: ppViewSlide, ppViewNormal


    RANGE1 = "E6"


    'Exportando tabela

    'Adicionar novo slide onde o grafico será colado
    'newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
    'newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.SlideIndex
    'Set activeSlide = newPowerPoint.ActivePresentation.Slides


    'Copia primeiro gráfico e cola no slide de PowerPoint como imagem Metafile

    ActiveWorkbook.Sheets("Consumo").Select
    ActiveSheet.Range(RANGE1).Select
    Selection.Copy

    'activeSlide.Shapes.PasteSpecial(DataType:=ppPaste Bitmap).Select

    nroSlide = InputBox("Em qual slide deve exportar? (vazio = slide corrente)")
    If nroSlide = "" Then
    activeSlide.Shapes.PasteSpecial(DataType:=ppPasteB itmap).Select
    Else
    newPowerPoint.ActiveWindow.View.GotoSlide nroSlide
    Set activeSlide = newPresentation.Slides _
    (newPowerPoint.ActiveWindow.Selection.SlideRange.S lideIndex)
    activeSlide.Shapes.PasteSpecial(DataType:=ppPasteB itmap).Select
    End If

    'ajuste de posição do gráfico
    newPowerPoint.ActiveWindow.Selection.ShapeRange.Le ft = 13
    newPowerPoint.ActiveWindow.Selection.ShapeRange.To p = 50
    newPowerPoint.ActiveWindow.Selection.ShapeRange.Wi dth = 50
    ActiveSheet.Range("G1").Select

    'flushing the clipboard
    Application.CutCopyMode = False
    Application.CutCopyMode = True

    Set activeSlide = Nothing ' Clean up variables
    Set newPresentation = Nothing
    Set newPowerPoint = Nothing

    End Sub


    But I need this as string on the first text box...
    Last edited by Saint'B; 09-15-15 at 14:22.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •