VBA Excel Intermediário - Exportando um Range para o PowerPoint

VBA Excel Intermediário - Exportando um Range para o PowerPoint

Exportar um range específico do nosso Dashboard diretamente para o MS Powerpoint deixou de ser um grande segredo e tornou-se a funcionalidade mais usada entre aqueles que conhecem um pouco de VBA. Por isso disponibilizo mais uma versão dessa possibilidade:

Sub ExcelRangeToPowerPoint(nSheet As String, NewPPT As Boolean, nRng As String, nLeft As Integer, nTop As Integer)
    '      Author: André Luiz Bernardes - A&A - In Any Place - andreluizbernardes@gmail.com
    '        Date: 11/05/2016 - 12:25
    ' Application: Field Force Dashboard Analysis®
    '     Purpose: Copy/Paste An Excel Range Into a New PowerPoint Presentation

Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object

'Copy Range from Excel
  Set rng = Sheets(nSheet).Range(nRng) 'ThisWorkbook.ActiveSheet.Range(nRng)

'Create an Instance of PowerPoint
  On Error Resume Next
    
    'Is PowerPoint already opened?
      Set PowerPointApp = GetObject(class:="PowerPoint.Application")
    
    'Clear the error between errors
      Err.Clear

    'If PowerPoint is not already open then open PowerPoint
      If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
    
    'Handle if the PowerPoint Application is not found
      If Err.Number = 429 Then
        MsgBox "PowerPoint não pôde ser aberto, abortando exportação."
        Exit Sub
      End If

  On Error GoTo 0

'Optimize Code
  Application.ScreenUpdating = False

'Create a New Presentation
  Set myPresentation = PowerPointApp.Presentations.Add

'Add a slide to the Presentation
  Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly

'Copy Excel Range
  rng.Copy

'Paste to PowerPoint and position
  mySlide.Shapes.PasteSpecial DataType:=2  '2 = ppPasteEnhancedMetafile
  Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
  
    'Set position:
      myShape.Left = nLeft
      myShape.Top = nTop

'Make PowerPoint Visible and Active
  PowerPointApp.Visible = True
  PowerPointApp.Activate

'Clear The Clipboard
  Application.CutCopyMode = False

End Sub



Se gostou, compartilhe este post com outros! Deixe seus comentários e sugestões.

brazilsalesforceeffectiveness@gmail.com

VBA Excel Intermediário - Como Desligar os Menus do MS Excel, Maximizando a Visualização do Dashboard? - Hide/Show Ribbon Programmaticaly

VBA Excel Intermediário - Como Desligar os Menus do MS Excel, Maximizando a Visualização do Dashboard?

Hide/Show Ribbon Programmaticaly

Ás vezes nossos Dashboards são enormes e desejamos que sejam mostrados em sua totalidade, por vezes, ocupando toda a tela. 

De fato, a visualização pode ficar fantástica, mas não queremos que ela seja prejudicada pelos menus padrões do MS Excel não é mesmo? Então, Como Desligar os Menus do MS Excel, Maximizando a Visualização do um Dashboard?

Use este código, que pode ser acionado através de um botão ou mesmo logo que o seu Dashboard for aberto:

Private Sub btnMenu01_Click()
    '      Author: André Luiz Bernardes - A&A - In Any Place - andreluizbernardes@gmail.com
    '        Date: 23/06/2016 - 09:33; 20/06/2016 - 08:08
    ' Application: Field Force Dashboard Analysis® - © ALLERGAN 2016, Inc. Todos os direitos reservados.
    '     Purpose: Load / Unload Main Menu.

    Dim nStat As Boolean
    Dim nLbl As String
    Dim nToolBarStr As String

    Let Application.ScreenUpdating = False

    ' Posiciona na Planilha.

    ActiveSheet.Select
    ActiveSheet.Activate

    If btnMenu01.Value Then
        Let nToolBarStr = "Show.ToolBar(""Ribbon"", False)"
        Let nStat = False
        'Let ActiveWindow.Zoom = 55

        ' Opções.
        Application.ExecuteExcel4Macro nToolBarStr

        Let Application.DisplayFormulaBar = nStat
        Let ActiveWindow.DisplayWorkbookTabs = nStat

        Range("A1").Select

        ' Mostra o Form.
        MainMenuFRM.Show (0)  ' 21.06.16
    Else
        Let nToolBarStr = "Show.ToolBar(""Ribbon"", True)"
        Let nStat = True
        'Let ActiveWindow.Zoom = 70

        ' Opções.
        Application.ExecuteExcel4Macro nToolBarStr

        Let Application.DisplayFormulaBar = nStat
        Let ActiveWindow.DisplayWorkbookTabs = nStat

        ActiveSheet.Range("A1").Select

        ' Esconde o Form.
        MainMenuFRM.Hide
    End If

    Let Application.ScreenUpdating = True

End Sub


Outra opção seria, simplesmente:

Sub HideRibbon()    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
End Sub 

Sub ShowRibbon()    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
End Sub

Somente nas versões do MS Excel 2010-2016 você poderá usar o comando: CommandBars.ExecuteMso "MinimizeRibbon"

Nestas versões também pdoerá checar o estado do Ribbon.

Sub test()

If RibbonState = 0 Then CommandBars.ExecuteMso "MinimizeRibbon"

End Sub 

Function RibbonState() As Long

'Result: 0=normal, -1=autohide

Let RibbonState = (CommandBars("Ribbon").Controls(1).Height < 100)

End Function

brazilsalesforceeffectiveness@gmail.com