Jump to content
kendy1290

Exportar gráficos do Excel para slides específicos doPower Point em VBA

Recommended Posts

Olá! Estou com problema referente a exportação de gráficos do Excel via VBA para apresentação do PowerPoint. A maneira que encontrei, inclusive em várias fontes é de exportar vários gráficos de uma vez ou uma ,em uma nova apresentação. O que estou precisando é de exportar os gráficos do Excel em um arquivo do PowerPoint existente, em slides e locais específicos das apresentações. Se alguém tiver alguma  ideia de como fazer seria de muita ajuda. 

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

  • Similar Content

    • By AlexandrePrezzi
      Bom dia....
      Mudei de planos quanto a minha exportação para excel,  porém continuo tendo problemas...
       
      Os arquivos em questão estao dentro do seguinte caminho...
       
      www/painel/src/view/rrc 
       
      PHPExcel (uma pasta com arquivos da biblioteca)
       
      PHPExcel.php  (arquivo da biblioteca)
      excel.php (arquivo de funções - copiado do exemplo da biblioteca )
      resultPrecoXLS.php  (arquivo que deveria criar a exportação do arquivo )
       
      Quando eu clico  pra gerar o arquivo esta me aparecendo um monte de caracteres na tela  ( em anexo a imagem do erro) 
       
      Abaixo os códigos em questão.
       
      Fico no aguardo se alguém tiver alguma sugestão.
       
      excel.php
       
      <?php function activeErrorReporting(){ error_reporting(E_ALL); ini_set('display_errors', TRUE); ini_set('display_startup_errors', TRUE); date_default_timezone_set('Europe/London'); } function noCli(){ if (PHP_SAPI == 'cli') die('This example should only be run from a Web Browser'); } function getHeaders(){ header('Content-Type: application/vnd.ms-excel'); header('Content-Disposition: attachment;filename="01simple.xls"'); header('Cache-Control: max-age=0'); // If you're serving to IE 9, then the following may be needed header('Cache-Control: max-age=1'); // If you're serving to IE over SSL, then the following may be needed header ('Expires: Mon, 26 Jul 1997 05:00:00 GMT'); // Date in the past header ('Last-Modified: '.gmdate('D, d M Y H:i:s').' GMT'); // always modified header ('Cache-Control: cache, must-revalidate'); // HTTP/1.1 header ('Pragma: public'); // HTTP/1.0 } ?> resultPrecoXLS.php 
      <?php require_once 'excel.php'; require_once 'request_precos.php'; activeErrorReporting(); //noCli(); require_once 'PHPExcel.php'; $objPHPExcel = new PHPExcel(); // Set document properties $objPHPExcel->getProperties()->setCreator("Zenite Sistemas") ->setLastModifiedBy("Zenite Sistemas") ->setTitle("Office 2007 XLSX Test Document") ->setSubject("Office 2007 XLSX Test Document") ->setDescription("Test document for Office 2007 XLSX, generated using PHP classes.") ->setKeywords("office 2007 openxml php") ->setCategory("Test result file"); // Add some data $objPHPExcel->setActiveSheetIndex(0) ->setCellValue('A1', 'Cód Prod') ->setCellValue('B1', 'Descrição') ->setCellValue('C1', 'Lista') ->setCellValue('D1', 'Preço'); $row = 2; foreach($_retorno as $res){ $objPHPExcel->setActiveSheetIndex(0) ->setCellValue('A'.$row , $res['CODPROD']) ->setCellValue('B'.$row, $res['CODPROD']) ->setCellValue('C'.$row, $res['CODPROD']) ->setCellValue('D'.$row, $res['CODPROD']); $row++; } // Rename worksheet $objPHPExcel->getActiveSheet()->setTitle('Lista de Preços'); // Set active sheet index to the first sheet, so Excel opens this as the first sheet $objPHPExcel->setActiveSheetIndex(0); getHeaders(); $objWriter = PHPExcel_IOFactory::createWriter($objPHPExcel, 'Excel5'); $objWriter->save('php://output'); exit;  

    • By Pedro_Gomes
      Sou estudante de Programação e nunca tinha usado VBA e tenho de entregar um trabalho, mas nunca tive formação nesta linguagem, e estou a ter problemas  no programa na parte de Pesquisar registros com filtros, já tentei ao máximo fazer seguindo tutoriais na internet, até que uma pessoua me ajudou e mandou-me codia e disse para fazer um passos só que eu nao sei seguir esses passos.
       Fico muito agradecido se alguém me conseguir ajudar.
         
      O que a pessoa me indicou:
      " Para testar o código coloque um filtro na planilha Dados no range A1:L1 e crie uma planilha com o nome de Auxiliar. Cole o código no formulário Pesquisar. "
       
      Option Explicit Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then Call Filtro(TextBox1.Text, ComboBox1.Text) End Sub Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then Call Filtro(TextBox2.Text, ComboBox2.Text) End Sub Private Sub TextBox3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then Call Filtro(TextBox3.Text, ComboBox3.Text) End Sub Private Sub UserForm_Initialize() ComboBox1.RowSource = "Relatório!A1:A12" ComboBox2.RowSource = "Relatório!A1:A12" ComboBox3.RowSource = "Relatório!A1:A12" End Sub Sub Filtro(ByVal Pesquisa As String, Campo As String) Dim Coluna As Integer Dim Area As Range Set Area = ThisWorkbook.Sheets("Dados").[A1:L1] Coluna = WorksheetFunction.Match(Campo, Area, 0) If Pesquisa <> "" Then If IsNumeric(Pesquisa) = False Then Pesquisa = "*" & Pesquisa & "*" Call Area.AutoFilter(Field:=Coluna, Criteria1:=Pesquisa) Call CopiaTabela Call PreencheListBox End If End Sub Sub CopiaTabela() ThisWorkbook.Sheets("Auxiliar").[A:L].Clear ThisWorkbook.Sheets("Dados").[A1].CurrentRegion.Copy ThisWorkbook.Sheets("Auxiliar").[A1].PasteSpecial xlPasteValues Application.CutCopyMode = False End Sub Sub PreencheListBox() Dim Area As Range Set Area = ThisWorkbook.Sheets("Auxiliar").[A1].CurrentRegion ListBox1.ColumnCount = Area.Columns.Count ListBox1.ColumnHeads = True ListBox1.RowSource = "Auxiliar!" & Area.Offset(1).Address End Sub Link do Programa: 
      https://drive.google.com/file/d/1ucJVL5Ijg0IcDqaFzoJi8aiMPb0NCbjI/view?usp=sharing
    • By AlexandrePrezzi
      Boa tarde,
      Estou tentando gerar um arquivo xls ao clicar em um botao "Gerar Excel" (em um primeiro momento estou usando um exemplo pronto básico)
       
      Baixei os arquivos da biblioteca e salvei na raiz do meu projeto
      /vendors (uma pasta com as classes da biblioteca)
      e mais dois arquivos composer soltos na raiz
      composer.json
      composer.lock  
       
      O arquivo que estou trabalhando esta no seguinte caminho 
      C:\wamp64\www\painel\src\view\rrc
       
      resultExcel.php
       
      de modo que para chegar na pasta vendors  eu usei o comando 

      require('/../../../vendor/autoload.php');
       
      Porem quando eu clico no botão para gerar ele me da um erro sugerindo não encontrar esse arquivo (erro na imagem)
       
       
      Obs:  Se eu criar um arquivo resultExcel.php   exatamente igual .. porem na raiz... funciona perfeitamente..... 

      Alguem sabe dizer pq dentro de uma estrutura de pastas da esse problema ?
       
       
      Segue código do resultExcel.php   (um modelo copiado de um exemplo)
       
      <?php // require_once 'vendor/autoload.php'; require('/../../../vendor/autoload.php'); use PhpOffice\PhpSpreadsheet\Spreadsheet; use PhpOffice\PhpSpreadsheet\Writer\Xlsx; use PhpOffice\PhpSpreadsheet\IOFactory; $spreadsheet = new Spreadsheet(); $sheet = $spreadsheet->getActiveSheet(); $sheet->setCellValue('A1', '#'); $sheet->setCellValue('B1', 'First'); $sheet->setCellValue('C1', 'Last'); $sheet->setCellValue('D1', 'Handle'); $sheet->setCellValue('A2', 1); $sheet->setCellValue('B2', 'Mark'); $sheet->setCellValue('C2', 'Jacob'); $sheet->setCellValue('D2', 'Larry'); $sheet->setCellValue('A3', 2); $sheet->setCellValue('B3', 'Jacob'); $sheet->setCellValue('C3', 'Thornton'); $sheet->setCellValue('D3', '@fat'); $sheet->setCellValue('A4', 3); $sheet->setCellValue('B4', 'Larry'); $sheet->setCellValue('C4', 'the Bird'); $sheet->setCellValue('D4', '@twitter'); $filename = 'sample-'.time().'.xlsx'; // Redirect output to a client's web browser (Xlsx) header('Content-Type: application/vnd.openxmlformats-officedocument.spreadsheetml.sheet'); header('Content-Disposition: attachment;filename="'.$filename.'"'); header('Cache-Control: max-age=0'); // If you're serving to IE 9, then the following may be needed header('Cache-Control: max-age=1'); // If you're serving to IE over SSL, then the following may be needed header('Expires: Mon, 26 Jul 1997 05:00:00 GMT'); // Date in the past header('Last-Modified: ' . gmdate('D, d M Y H:i:s') . ' GMT'); // always modified header('Cache-Control: cache, must-revalidate'); // HTTP/1.1 header('Pragma: public'); // HTTP/1. $writer = IOFactory::createWriter($spreadsheet, 'Xlsx'); $writer->save('php://output');  
       
       
       
    • By gereiz
      Bom dia a todos. Adaptei um código para renomear vários arquivo com vba, que realiza a seguinte função:
       
      1) Eu seleiono a pasta,
      2) O VBA abre o PDF (Nota fiscal) , extrai a informação do texto e com a razão social fecha o pdf e renomeia ele com o nome extraido.
       
      O problema é que após renomear o primeiro arquivo corretamente a execução do código trava, e é necessário finalizar o processo.
      Segue abaixo o código.
      Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) Public Function ListaArquivos(ByVal Caminho As String) As String()          'Atenção: Faça referência à biblioteca Micrsoft Scripting Runtime     Dim FSO As New FileSystemObject     Dim result() As String     Dim Pasta As Folder     Dim Arquivo As File     Dim Indice As Long         ReDim result(0) As String     If FSO.FolderExists(Caminho) Then         Set Pasta = FSO.GetFolder(Caminho)           For Each Arquivo In Pasta.Files             Indice = IIf(result(0) = "", 0, Indice + 1)             ReDim Preserve result(Indice) As String             result(Indice) = Arquivo.Name         Next     End If       ListaArquivos = result ErrHandler:     Set FSO = Nothing     Set Pasta = Nothing     Set Arquivo = Nothing End Function Private Sub selecionar_pasta()  Dim box As Folder  Dim arquivos() As String  Dim lCtr As Long  Dim AdobeApp As String  Dim StartAdobe  Dim Arquivo As String  Dim NomeAntigo As String  Dim NomeNovo As String        On Error Resume Next      linha = 1      ultima_linha = Sheets("teste").Cells(Rows.Count, 1).End(xlUp).Row                  With Application.FileDialog(msoFileDialogFolderPicker)             .Title = "Buscar pasta"             .InitialFileName = ThisWorkbook.Path             .Show             .AllowMultiSelect = False             Pasta = .SelectedItems(1)         End With         TextBox1 = box          arquivos = ListaArquivos(Pasta)     Sleep 1000     For lCtr = 0 To UBound(arquivos)       Debug.Print arquivos(lCtr)         'Inserir código aqui'                  'Cells(linha, 1).Value = arquivos(lCtr)         'linha = (linha + 1)         'Sleep 500                                 pdf = arquivos(lCtr)                    AdobeApp = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe"                      Sleep 2000                                          For Each pdf In Pasta                                 Adobefile = Pasta & "\" & pdf                    StartAdobe = Shell("" & AdobeApp & " " & """" & Adobefile & """" & "", 1)                              Sleep 2000                                         Application.SendKeys ("^a")             Application.SendKeys ("^c")              Sleep 2000                                    Dim KillPdf As String            KillPdf = "TASKKILL /F /IM AcroRd32.exe"            Shell KillPdf, vbHide                                               AppActivate Application.Caption                                            Sheets("teste").Range("A1").Activate             SendKeys ("^v")                                   DoEvents                                                                     Dim Razao As String             Razao = Sheets("teste").Range("A17").Value             pontos = InStr(1, Razao, ":")             qtdeLetras = Len(Razao)             Nome = Right(Razao, qtdeLetras - pontos)             Sheets("teste").Range("C1").Value = Nome                                                                   Do While Not IsEmpty(Range("C1"))                                              NomeAntigo = Pasta & "\" & pdf                                      NomeNovo = Pasta & "\" & Sheets("teste").Range("C1").Value & ".pdf"                                  Sheets("teste").Range("C2").Value = Adobefile                                      Sheets("teste").Range("C3").Value = Pasta & "\" & Sheets("teste").Range("C1").Value & ".pdf"                                                       Name NomeAntigo As NomeNovo                                                                  ' DoEvents                                         Loop                       ' MsgBox "Nomes dos arquivos alterados!", vbOKOnly, "Processo Concluído"                                                Next                       Next           ' MsgBox ("Arquivos Encontrados = ") & (linha - 1)                    End Sub Já tentei de tudo, e não consegui resolver esse problema, se eu remover o Do while, ele executa normalmente, porem não renomeia os arquivos. Seu eu faço esse laço, ele renomeia só o primeiro e trava geral.
       
      Qualquer esclarecimento, agradeço.

       
    • By asacap1000
      Salva galera, a tempo eu exporto os dados de consultas realizadas em  nossa intranet, para excel. Porém hoje estamos precisando dividir algumas informações. por exemplo consulto saldo de estoque do cliente, e cada saldo corresponde a um documento, hoje eu trago em apenas uma aba na planilha mas o cliente solicitou para gerar cada documento uma aba ex:

       
      Eu pesquisei mas não encontrei nada que falasse sobre isso.
      hoje utilizo algo simples para exportar.

       
       
       
×

Important Information

Ao usar o fórum, você concorda com nossos Terms of Use.