VBA Excel Intermediário - Exportando DOIS Ranges Simultaneamente para o PowerPoint

VBA Excel Intermediário - Exportando DOIS Ranges Simultaneamente para o PowerPoint

Sim, caso nosso Dashboard seja grande demais, ou tenha pequenas partes que gostaria de destacar durante a sua apresentação, talvez decida exportar pequenas partes em slides separados, logo após tê-los exportado juntos.

Ter a liberdade de poder efetuar essa exportação com a mesma funcionalidade técnica é sempre uma bem recebida solução para a nossa correria do dia a dia.

Um plus+ neste código é o que verá no arremate da colagem da imagem, quando o script tenta adequar o tamanho da imagem ao slide onde está sendo colado. 

Começa assim:

    Dim nTitle As String
    Dim nRngName01 As String

    Dim nRngName02 As String

     Let nRngName01 = "TOP"
     Let nRngName02 = "BODY"

     Let nTitle = ActiveSheet.Range("AB9").Value

    Call XPortRng2PPT (nRngName01, nRngName02, nSheetName, nTitle)

Continue assim:

Sub XPortRng2PPT (nRngName01 As String, nRngName02 As String, nSheet As String, nTitle As String)
    '      Author: André Luiz Bernardes - A&A - In Any Place - andreluizbernardes@gmail.com
    '        Date: 01/06/2016 - 10:32
    ' Application: Field Force Dashboard Analysis® 
    '     Purpose: Copy/Paste An Excel Range Into a New PowerPoint Presentation

    Dim ActFileName As Variant
    Dim ScaleFactor As Single

    On Error GoTo ErrorHandling

    Let ActFileName = Application.GetOpenFilename("Microsoft PowerPoint-Files (*.pptx), *.ppt")
    Let ScaleFactor = Range("myScaleFactor").Value

    Application.Sheets(nSheet).Select

    Set PP = CreateObject("Powerpoint.Application")

    If ActFileName = False Then
        PP.Activate
        PP.Presentations.Add
        Set PP_File = PP.ActivePresentation
    Else
        PP.Activate
        Set PP_File = PP.Presentations.Open(ActFileName)
    End If

    Let PP.Visible = True

    CopyandPastetoPPT nRngName01, nTitle, ScaleFactor, ScaleFactor
    CopyandPastetoPPT nRngName02, nTitle, ScaleFactor, ScaleFactor

    Set PP_Slide = Nothing
    Set PP_File = Nothing
    Set PP = Nothing

    Application.Sheets(nSheet).Activate
Exit Sub

ErrorHandling:

Set PP_Slide = Nothing
Set PP_File = Nothing
Set PP = Nothing

MsgBox "Error No.: " & Err.Number & vbNewLine & vbNewLine & "Description: " & Err.Description, vbCritical, "Error"

End Sub

Sub CopyandPastetoPPT (myRangeName As String, _
                              myTitle As String, _
                              myScaleHeight As Single, _
                              myScaleWidth As Single)
    '      Author: André Luiz Bernardes - A&A - In Any Place - andreluizbernardes@gmail.com
    '        Date: 01/06/2016 - 10:32
    ' Application: Field Force Dashboard Analysis®
    '     Purpose: Copy/Paste.

    Dim NextShape As Integer

    Application.GoTo Reference:=myRangeName

    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    
    Range("A1").Select

    PP.ActivePresentation.Slides.Add PP.ActivePresentation.Slides.Count + 1, 11

    Set PP_Slide = PP_File.Slides(PP.ActivePresentation.Slides.Count)
    Let PP_Slide.Shapes.Title.TextFrame.TextRange.Text = myTitle
    Let NextShape = PP_Slide.Shapes.Count + 1

    PP_Slide.Shapes.PasteSpecial 2
    
    PP_Slide.Shapes(NextShape).ScaleHeight myScaleHeight, 1
    PP_Slide.Shapes(NextShape).ScaleWidth myScaleWidth, 1
    PP_Slide.Shapes(NextShape).Left = PP_File.PageSetup.SlideWidth \ 2 - PP_Slide.Shapes(NextShape).Width \ 2
    PP_Slide.Shapes(NextShape).Top = 90

End Sub


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

brazilsalesforceeffectiveness@gmail.com

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 - Exporte as planilhas para PDF ou XPS - Export Data to PDF or XPS Using the Excel.ExportAsFixedFormat Method

| Blog Office VBA | Blog Excel | Blog Access | Blog Infochart | 

Você tem direito as informações da sua empresa

MIS - Usufruindo a excelência na análise das suas Informações

Dados ou Informações?

Dashboards - 8 Importantes características desejáveis

Key Performance Indicators - 7 Características desejáveis

Tópicos relacionados:

Business English - Termos em inglês do mundo dos negócios - Speaking the lingo

Acrônimos - Technology, Electronics and Games Acronyms

13 Dicas para se Falar em Público

Os 10 mandamentos do gerenciamento de projetos

KPI - Key Performance Indicator

Acesse: http://goo.gl/0v6AO   

Este exemplo mostra como usar o método ExportAsFixedFormat para exportar uma série de dados em uma planilha do Microsoft Excel para o formato PDF ou XPS.

Sub TestExportAsFixedFormat() 

  ' For information on the final parameter, see this page: 

  ' http://msdn.microsoft.com/en-us/library/aa338206.aspx 

  

  Dim rng As Range 

  Set rng = Range("A1:E10") 

  SetupRangeData rng 

  

  Dim fileName As String 

  ' Change this file name to meet your own needs: 

  Let fileName = "C:\Temp\Export.pdf" 

  

  ' Many of these properties are optional, and are included 

  ' here only to demonstrate how you might use them. The 

  ' Type parameter can be one of xlTypePDF and xlTypeXLS; 

  ' the Quality parameter can be one of xlQualityStandard and 

  ' xlQualityMinimum. Setting the OpenAfterPublish property 

  ' to True will fail if you don't have a default viewer 

  ' installed and configured. 

  

  rng.ExportAsFixedFormat Type:=xlTypePDF, _ 

   fileName:=fileName, Quality:=xlQualityStandard, _ 

   IncludeDocProperties:=True, IgnorePrintAreas:=True, _ 

   From:=1, To:=1, OpenAfterPublish:=True 

End Sub 

Sub SetupRangeData(rng As Range) 

  Let rng.Formula = "=RANDBETWEEN(1, 100)" 

End Sub 

Anexos:

Excel.ExportAsFixedFormat.txt

Office 2010 101 Code Samples.zip

Tags: VBA, Excel, Export, Data, PDF, XPS, ExportAsFixed, Format, Method

Excel VBA - Copie qualquer objeto como imagem e exporte-o

|bernardess @ gmail . com| Skype:InAnyPlace|Blog Office VBA|Blog Excel|Blog Access |

Lembro-me de há alguns, quando criei este Blog específico de VBA, como ainda era incipiente a inter-colaboração de códigos VBA no mercado nacional, bem como a utilização profissional de Dashboards e Scorecards. O desenvolvimento VBA naquela época restringia-se aos expressão "faz-se macros no excel'. Hoje, estamos vivenciando um mercado de desenvolvimento VBA mais maduro, cheio de profissionais competentíssimos (tomara que essa expressão não seja um neologismo), com inúmeras excelentes soluções de desenvolvimento e aplicações de automação. Encontramo-nos amadurecidos e prontos para avançarmos no nosso ciclo de aprimoramento profissional!

English references:

You can export a chart to an image file using VBA

Chart to Image Conversion using VBA

Excel Chart to GIF Conversion using VBA

Export Excel Chart to Image using VB

Save Chart as image

Export function of the Chart

To copy a selected Excel chart or range object as a picture

Image File Type Comparison of Exported Charts

Image Export - Org Chart in Excel Worksheet

Best format to export Excel Range to picture

Export Chart as Image: Run-time error 1004

Exporting a Chart(object) EXCEL VBA

Saving a chart as a picture file

Paste Chart from Excel to VBA form

Using VBA to Export Charts as Images in Excel 2007

How can I export a chart as a jpg/tif? in Excel Charting?

How to superimpose chart images or extract data by vba in Excel?

How to convert Excel to jpg, gif image?

How to Export A Picture Or Chart From Excel To Powerpoint?

O artigo a seguir visa elevar a qualidade da nossa entrega. Enviar o conteúdo das nossas soluções para outros ambientes e interfaces. Das aplicações da suíte MS Office, a editores gráficos para a criação de Info Gráficos e até mesmo a inserção destes em páginas da Web de modo automático (Sharepoint). Mas prá que quero isso? Talvez pergunte-se. Abaixo seguem diversos códigos bem elaborados que possibilitarão copiar os gráficos das suas planilhas pré-existentes, bem como os ranges de dados destas (conjuntos de células previamente selecionados) como uma imagem. Detalho:

Por vezes desejará não enviar a fonte de dados junto com o gráfico para um Slide que lhe solicitaram.

Talvez deseje enviar uma tabela, um relatório, partes de um Balanced Scorecard, um Dashboards ou um Scorecards, ou mesmo um conjunto de KPIs, sem que estes sejam alterados por quem recebê-los.

Criar um informativo regular, parte de um relatório, que envia via MS Outlook, comentários dos

relatórios, agregando conteúdo analítico e não apenas gráficos e dados estáticos para o público alvo.

Como fazê-lo? Com os recursos abaixo alistados, poderá enviar somente as imagens, como se tirasse uma foto e colasse no Slide, num documento MS Word, num e-mail e até mesmo no Photoshop (há!). Chega! Essas são apenas algumas das possibilidades...Pensem em outras...

CÓDIGO:

ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture


Para copiar um gráfico selecionado (ou ativo) em uma planilha, implemente a seguinte sintaxe:

CÓDIGO:

ActiveChart.CopyPicture Appearance:=xlScreen, Format:=xlPicture


Copiando um range de dados, colando-a como uma imagem::

CÓDIGO:

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


Copie gráficos selecionados (ou ativo) em uma planilha, implemente a seguinte sintaxe:

CÓDIGO:

Worksheets("Nome da pasta").ChartObjects(1).Chart.CopyPictureAppearance:=xlScreen, Size:=xlScreen, Format:=xlPicture


Copie uma faixa de dados específica, embora não esteja selecionada, colando-a a posteriori::

CÓDIGO:

Worksheets("Nome da pasta").Range("B11:AF25").CopyPicture Appearance:=xlScreen, Format:=xlPicture

Pois é, sempre existem códigos admiráveis por aí:

CÓDIGO:

Sub GraficoToPowerPoint() Dim objPPT As Object Dim objPrs As Object Dim shtTemp As Worksheet Dim chtTemp As ChartObject Dim intSlide As Integer Set objPPT = CreateObject("Powerpoint.application") objPPT.Visible = True objPPT.presentations.Open ThisWorkbook.Path & "\Dashboard_Bernardes.ppt" objPPT.ActiveWindow.ViewType = 1 'ppViewSlide For Each shtTemp In ThisWorkbook.Worksheets For Each chtTemp In shtTemp.ChartObjects intSlide = intSlide + 1 chtTemp.CopyPicture If intSlide > objPPT.presentations(1).Slides.Count Then objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.presentations(1).Slides.Add(Index:=intSlide, Layout:=1).SlideIndex End If objPPT.ActiveWindow.View.Paste Next Next objPPT.presentations(1).Save objPPT.Quit Set objPrs = Nothing Set objPPT = Nothing End Sub


Copiando range e gráfico para o MS Powerpoint:

CÓDIGO:

Sub GraficoRange_TO_Powerpoint() Dim objPPT As Object Dim objPrs As Object Dim objSld As Object Dim shtTemp As Object Dim chtTemp As ChartObject Dim objShape As Shape Dim objGShape As Shape Dim intSlide As Integer Dim blnCopy As Boolean Set objPPT = CreateObject("Powerpoint.application") objPPT.Visible = True objPPT.Presentations.Add objPPT.ActiveWindow.ViewType = 1 For Each shtTemp In ThisWorkbook.Sheets blnCopy = False If shtTemp.Type = xlWorksheet Then For Each objShape In shtTemp.Shapes blnCopy = False If objShape.Type = msoGroup Then For Each objGShape In objShape.GroupItems If objGShape.Type = msoChart Then blnCopy = True Exit For End If Next End If If objShape.Type = msoChart Then blnCopy = True If blnCopy Then intSlide = intSlide + 1 objShape.CopyPicture objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex objPPT.ActiveWindow.View.Paste End If Next If Not blnCopy Then intSlide = intSlide + 1 shtTemp.UsedRange.CopyPicture objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex objPPT.ActiveWindow.View.Paste End If Else intSlide = intSlide + 1 shtTemp.CopyPicture objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex objPPT.ActiveWindow.View.Paste End If Next Set objPrs = Nothing Set objPPT = Nothing End Sub

Bônus:

CÓDIGO:

Sub RangeUsado_TO_Powerpoint() Dim objPPT As Object Dim shtTemp As Object Dim intSlide As Integer Set objPPT = CreateObject("Powerpoint.application") objPPT.Visible = True objPPT.Presentations.Open ThisWorkbook.Path & "\Bernardes.ppt" objPPT.ActiveWindow.ViewType = 1 For Each shtTemp In ThisWorkbook.Sheets shtTemp.Range("A1", shtTemp.UsedRange).CopyPicture xlScreen, xlPicture intSlide = intSlide + 1 objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex objPPT.ActiveWindow.View.Paste With objPPT.ActiveWindow.View.Slide.Shapes(objPPT.ActiveWindow.View.Slide.Shapes.Count) .Left = (.Parent.Parent.SlideMaster.Width - .Width) / 2 End With Next Set objPPT = Nothing End Sub

Boa diversão! Tags: André Luiz Bernardes, TI, Tecnologia da Informação, Dashboard, Scorecard, Infographic, infochart, infográfico, portfolio, YTD, YTG, KPI, sparklines, charts, Pivot Table, slicers, bullet, Scroll chart, gráfico, mini-gráfico, termômetro, Velocímetro, Gauge, relatório, MS, Microsoft, Office, Excel, Access, Outlook, Powerpoint, Organização, Ordenação, Formatação, numérico, projeto, ranqueado, painel, clustering, redes neurais, métodos genéticos, mineração em textos, roll up, drill down, KPI, KPIs, Key performance Indicator, escopo, stakeholder, indicadores, DW, Data Warehousing, BSM, Business Scorecard Manager, BSC, Balanced Scorecard, Dashboard, características, infochart, chart, infográfico, gráfico, drugs, drogas, Ilegal, Américas, análise, Data Mining Tweeder, The Health Tweeder, algoritmo, data mining, Mineração de Dados, colaborativa, rede social, social mídia, community, facebook, like, friendwheel, google play, health tweeder, infographic, keyword, like button, likebutton.me, mentionmap, MSNBC spectra, network,news feed, rss, search, topics, touchgraph, twitter, twitter venn, visual, evolução, dólar, Real, superimposição, finanças, financeiro, contábil, contabilidade, crédito, débito

Outras referências:

VBA POWERPOINT: Atualizando gráfico com dados do MS Excel

Copy Charts To Powerpoint Slides (charts As Sheets)‎
Charts to PowerPoint‎
Copy Chart And Table To Powerpoint‎
export Excel chart to powerpoint‎

André Luiz Bernardes

A&A® - Work smart, not hard.

Twitter:@bernardess|bernardess@gmail.com| Skype:InAnyPlace

|Blog Office VBA|Blog Excel|Blog Access |