VB .NET - Automatizando o PowerPoint

 Neste tutorial vamos recordar como automatizar o PowerPoint a partir de uma aplicação VB .NET.

Neste tutorial veremos uma aplicação VB .NET bem simples que mostra como acessar o PowerPoint e realizar tarefas como : criar uma apresentação, incluir um slide , um gráfico , uma tabela , adicionar um texto.

Para isso vamos usar os recursos dos namespaces : Imports Microsoft.Office.Interop e  Imports Microsoft.Office.Core.

Os dados usados como exemplo são obtidos do arquivo XML :  ShipmentData.xml 

<?xml version="1.0" encoding="utf-8"?>
<ShipmentSchema xmlns="http://tempuri.org/ShipmentSchema.xsd">
  <Shipment>
    <Cidade>Santos</Cidade>
    <Volume>33</Volume>
  </Shipment>
  <Shipment>
    <Cidade>Brasilia</Cidade>
    <Volume>22</Volume>
  </Shipment>
  <Shipment>
    <Cidade>Campinas</Cidade>
    <Volume>11</Volume>
  </Shipment>
  <Shipment>
    <Cidade>Goiania</Cidade>
    <Volume>5</Volume>
  </Shipment>
</ShipmentSchema>

Então ao trabalho...

Recursos Usados:

Criando o projeto Windows Forms no VS Community 2017

Abra o VS 2017 Community e crie um projeto usando a opção : Visual Basic -> Windows Classic Desktop e selecione o template Windows Forms App (.NET Framework);

Informe o nome PowerPointAuto e clique no botão OK;

Vamos incluir os componentes Label, Button e TextBox a partir da Toolbox para criar a interface com o usuário conforme o leiaute abaixo:

A seguir defina as variáveis abaixo que serão usadas no formulário:

Dim objPPT As PowerPoint.Application
Dim objPres As PowerPoint.Presentation

Definindo o código do formulário

Agora vamos definir o código de cada evento Click associado aos botões de comando e a cada método que for invocado.

1- Iniciando o PowerPoint

Private Sub cmdStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdIniciar.Click
        IniciarPowerPoint()
End Sub

2- Código do método IniciarPowerPoint()

 Sub IniciarPowerPoint()
        objPPT = New PowerPoint.Application
        objPPT.Visible = MsoTriState.msoTrue
        objPPT.WindowState = PowerPoint.PpWindowState.ppWindowMaximized
 End Sub

3- Criando uma nova apresentação

 Private Sub cmdCriarApresentacao_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
 Handles cmdCriarApresentacao.Click
        AsseguraPowerPointEstaEmExecucao(False, False)
        'Adiciona Apresentacao
        objPres = objPPT.Presentations.Add(MsoTriState.msoTrue)
 End Sub

4- Código do método AsseguraPowerPointEstaEmExecucao()

 Sub AsseguraPowerPointEstaEmExecucao(Optional ByVal blnAdicionaApresentacao As Boolean = False, 
                                                               Optional ByVal blnAdicionaSlide As Boolean = False)
        Dim strNome As String
        'Tenta acessar a propriedade nome
        Try
            strNome = objPPT.Name
        Catch ex As Exception
            IniciarPowerPoint()
        End Try
        '
        If blnAdicionaApresentacao = True Then
            Try
                strNome = objPres.Name
            Catch ex As Exception
                objPres = objPPT.Presentations.Add(MsoTriState.msoTrue)
            End Try
        End If
        '
        If blnAdicionaSlide Then
            Try
                strNome = objPres.Slides(1).Name
            Catch ex As Exception
                Dim objSlide As PowerPoint.Slide
                Dim objCustomLayout As PowerPoint.CustomLayout
                objCustomLayout = objPres.SlideMaster.CustomLayouts.Item(1)
                objSlide = objPres.Slides.AddSlide(1, objCustomLayout)
                objSlide.Layout = PowerPoint.PpSlideLayout.ppLayoutText
                objCustomLayout = Nothing
                objSlide = Nothing
            End Try
        End If
    End Sub

5 - Adicionando um Slide

Private Sub cmdAdicionarSlide_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
Handles cmdAdicionarSlide.Click
        Dim objSlide As PowerPoint.Slide
        Dim objCustomLayout As PowerPoint.CustomLayout
        AsseguraPowerPointEstaEmExecucao(True)
        'Cria um layout customizado baseado no primeiro layoute master para simplificar
        objCustomLayout = objPres.SlideMaster.CustomLayouts.Item(1)
        'Cria slide
        objSlide = objPres.Slides.AddSlide(1, objCustomLayout)
        'Define o layout
        objSlide.Layout = PowerPoint.PpSlideLayout.ppLayoutText
        'Limpa
        objCustomLayout.Delete()
        objCustomLayout = Nothing
        objSlide = Nothing
nd Sub

6- Removendo um Slide

Private Sub cmdRemoverSlide_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) 
Handles cmdRemoverSlide.Click
        AsseguraPowerPointEstaEmExecucao(True)
        If objPres.Slides.Count > 0 Then
            objPres.Slides(1).Delete()
        Else
            MsgBox("Nenhum slide para remover", MsgBoxStyle.Information)
        End If
End Sub

7- Definindo um título

Private Sub cmdDefinirTitulo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) 
Handles cmdDefinirTitulo.Click
        Dim i As Integer
        AsseguraPowerPointEstaEmExecucao(True, True)
        'Adiciona Text ao titulo do slide
        'Se não existe não faz nada
        objPres.Slides(1).Select()
        For i = 1 To objPres.Slides(1).Shapes.Count
            If objPres.Slides(1).Shapes(i).HasTextFrame Then
                objPres.Slides(1).Shapes(i).TextFrame.TextRange.Text = Me.txtTitle.Text
                Exit For
            End If
        Next i
End Sub

8- Adiciona um gráfico

Private Sub cmdAdicionarGrafico_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) 
Handles cmdAdicionarGrafico.Click
        Dim ds As New ShipmentSchema, dt As ShipmentSchema.ShipmentDataTable
        AsseguraPowerPointEstaEmExecucao(True, True)
        'carrega dados do arquivo xml 
        ds.ReadXml(My.Application.Info.DirectoryPath & "\ShipmentData.xml")
        dt = ds.Tables("Shipment")
        'Inicia o excel, popula a planilha com dados XML, cria o gráfico no Excel e copia para o Powerpoint
        Dim objExcel As Excel.Application
        Dim objWorkbook As Excel.Workbook
        Dim objSheet As Excel.Worksheet
        Dim objChart As Excel.Chart
        objExcel = New Excel.Application
        objExcel.Visible = True
        objWorkbook = objExcel.Workbooks.Add
        objSheet = objWorkbook.Sheets("Planilha1")
        DataTableParaPlanilhaExcel(dt, objSheet, 1, 1)
        objSheet.Range("A1:B4").Select()
        objChart = objExcel.Charts.Add()
        With objChart
            'gráfico de pizza 3D
            .ChartType = Excel.XlChartType.xl3DPie
            .ChartStyle = 10
            'permite redimensionar o grafico
            .AutoScaling = False
            .Elevation = 30
            .Select()
        End With
        Application.DoEvents()
        'Copia a imagem do grafico para o clipboard
        objChart.CopyPicture(Excel.XlPictureAppearance.xlPrinter, Excel.XlCopyPictureFormat.xlPicture, 
Excel.XlPictureAppearance.xlPrinter)
        'cola no PowerPoint
        objPPT.Activate()
        Dim objSlide As PowerPoint.Slide
        Dim objShape As PowerPoint.Shape
        objSlide = objPres.Slides(1)
        objSlide.Select()
        objSlide.Layout = PowerPoint.PpSlideLayout.ppLayoutTitleOnly
        objSlide.Shapes.Paste()
        objShape = objSlide.Shapes(2)
        objShape.ZOrder(MsoZOrderCmd.msoSendToBack)
        objShape.Left = 400
        objShape.Top = 100
        'Limpa
        objWorkbook.Close(False)
        objExcel.Quit()
        objExcel = Nothing
    End Sub

9- Código do método DataTableParaPlanilhaExcel

Sub DataTableParaPlanilhaExcel(ByVal dt As DataTable, ByVal objSheet As Excel.Worksheet, ByVal nStartRow As Integer, ByVal nStartCol As Integer)
        Dim nRow As Integer, nCol As Integer
        'copia o  datatable na planilha excel
        For nRow = 0 To dt.Rows.Count - 1
            For nCol = 0 To dt.Columns.Count - 1
                objSheet.Cells(nStartRow + nRow, nStartCol + nCol) = dt.Rows(nRow).Item(nCol)
            Next nCol
        Next nRow
End Sub

10- Adicionando um tabela

Private Sub cmdAdicionarTabela_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdAdicionarTabela.Click
        Dim objShape As PowerPoint.Shape
        Dim objTable As PowerPoint.Table
        AsseguraPowerPointEstaEmExecucao(True, True)
        'Carrega o  data table a partir do arquivo XML
        Dim ds As New ShipmentSchema, dt As ShipmentSchema.ShipmentDataTable
        ds.ReadXml(My.Application.Info.DirectoryPath & "\ShipmentData.xml")
        dt = ds.Tables("Shipment")
        'Adiciona a tabela no primeiro slide
        objPres.Slides(1).Select()
        objShape = objPres.Slides(1).Shapes.AddTable(5, 2, 50, 100, 300)
        objTable = objShape.Table
        'Popula a tabela do dataset
        With objShape.Table
            .Cell(1, 1).Shape.TextFrame.TextRange.Text = dt.Columns.Item(0).ColumnName
            .Cell(1, 2).Shape.TextFrame.TextRange.Text = dt.Columns.Item(1).ColumnName
            'Aplica um estilo na tabela usando o estilo GUID
            .ApplyStyle("{B301B821-A1FF-4177-AEE7-76D212191A09}", False)
            Dim nRow As Integer, nCol As Integer
            For nRow = 0 To dt.Rows.Count - 1
                For nCol = 0 To dt.Columns.Count - 1
                    .Cell(2 + nRow, 1 + nCol).Shape.TextFrame.TextRange.Text = dt.Rows(nRow).Item(nCol)
                Next nCol
            Next nRow
        End With
        'Limpa
        objTable = Nothing
        objShape = Nothing
        dt = Nothing
        ds = Nothing
End Sub

11- Adicionando um Texto

 Private Sub cmdAdicionarTextbox_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdAdicionarTextbox.Click
        Dim objShape As PowerPoint.Shape
        Dim strText As String = "Campinas : embarques aumento de 10%" & vbCrLf & "Santos : embarque pronto"
        AsseguraPowerPointEstaEmExecucao(True, True)
        objPres.Slides(1).Select()
        objShape = objPres.Slides(1).Shapes.AddTextbox(MsoTextOrientation.msoTextOrientationHorizontal, 50, 300, 300, 300)
        objShape.TextFrame.AutoSize = PowerPoint.PpAutoSize.ppAutoSizeShapeToFitText
        objShape.TextFrame.TextRange.Text = strText
        objShape.TextEffect.FontSize = 20
        objShape.TextEffect.FontBold = MsoTriState.msoTrue
        'Limpa
        objShape = Nothing
End Sub

12- Encerrando a aplicação - Menu Sair

 Sub IniciarPowerPoint()
        objPPT = New PowerPoint.Application
        objPPT.Visible = MsoTriState.msoTrue
        objPPT.WindowState = PowerPoint.PpWindowState.ppWindowMaximized
    End Sub

Pronto. Agora basta testar o projeto.

Ao executar o projeto usando este código iremos obter o seguinte resultado:

Pegue o projeto completo aqui :   PowerPointAuto.zip

"Respondeu Jesus: O meu reino não é deste mundo; se o meu reino fosse deste mundo, pelejariam os meus servos, para que eu não fosse entregue aos judeus; mas agora o meu reino não é daqui."
João 18:36

Veja os Destaques e novidades do SUPER DVD Visual Basic (sempre atualizado) : clique e confira !

Quer migrar para o VB .NET ?

Quer aprender C# ??

Quer aprender os conceitos da Programação Orientada a objetos ?

Quer aprender o gerar relatórios com o ReportViewer no Visual Studio ?

Quer aprender a criar aplicações Web Dinâmicas usando a ASP .NET ?

 

Gostou ?   Compartilhe no Facebook   Compartilhe no Twitter

Referências:

José Carlos Macoratti