Vamos ver uma include para gerar relatórios em planilha Excel de forma mais simplificada e vamos aproveitar para verificar qual office está instalado no computador para gerar sem a necessidade de ter o Microsoft Office instalado.
Esta include deve funcionar com Microsoft Office, Libre Office e Open Office. Não testei com outros programas.
Para que o próprio sistema identifique qual Office está instalado e o utilize use o comando: RUN identifica_office.
Caso queira forçar o uso de um Office específico, uso o comando RUN MS_office. para o Microsoft Office ou RUN open_office. para executar o Open ou Libre Office.
Veja a baixo o código completo da include:
/***************************************************************************
File : geraPlanilha.i
Purpose : Reconhecer qual office esta instalado e gerar uma planilha simples conforme o pacote identificado
MS Office ou Open Office
Syntax : {generico\geraPlanilha.i}
Author(s) : Fabiano Soares
Created : 24/10/2022
Usage :
RUN identifica_office. /* Idenficica qual office esta instalado e o usa para gerar planilha */
RUN MS_office. /* Faz geração de planilha com Microsoft Office */
RUN open_office. /* Faz geração de planilha com Open Office */
RUN new_book. /* Gera Planilha nova */
RUN open_book(filename). /* Abre uma planilha passada por parametro */
RUN hide_office. /* Esconde a planilha enquanto gera os dados */
RUN write_cell_header(coluna,linha,texto). /* Registra o conteúdo com destaque, tamanho da fonte 12 e em negrito */
RUN write_cell_text(coluna,linha,texto). /* Informe o conteúdo */
RUN write_cell_number(coluna,linha,number). /* Informe o conteúdo da celula, vai converter para decimal */
RUN SET_function(coluna,linha,"=sum(B2:C2)"). /* Grava uma função na célula */
RUN set_font_style(coluna,linha,'Arial',16,TRUE,6,2). /* Altera o estilo da fonte */
RUN save_book("C:\Fabiano\","teste"). /* Salva o documento no diretório informado */
RUN show_office. /* Mostra a planilha */
RUN CleanUp. /* Faz limpeza do cache */
RUN close_Office. /* Fecha o office aberto e faz limpeza do cache */
***************************************************************************/
/*********** Define Global Variables ***********/
DEFINE VARIABLE chOffice AS COM-HANDLE NO-UNDO.
DEFINE VARIABLE chWorkBook AS COM-HANDLE NO-UNDO.
DEFINE VARIABLE chDesktop AS COM-HANDLE NO-UNDO.
DEFINE VARIABLE chWorkSheet AS COM-HANDLE NO-UNDO.
DEFINE VARIABLE chCell AS COM-HANDLE NO-UNDO.
DEFINE VARIABLE iRow AS INTEGER NO-UNDO.
DEFINE VARIABLE iCol AS INTEGER NO-UNDO.
DEFINE VARIABLE chrLabel AS CHARACTER NO-UNDO.
DEFINE VARIABLE cc AS RAW NO-UNDO.
DEFINE VARIABLE PctMSOffice AS LOGICAL NO-UNDO INITIAL FALSE.
ASSIGN
chOffice = ?
chWorkBook = ?
chDesktop = ?
chWorkSheet = ?.
/* ************************ Function ***************** */
FUNCTION getPosColuna RETURNS INTEGER
( INPUT p_Col AS CHARACTER ) :
/*------------------------------------------------------------------------------
Purpose: Retorna a posição numerica da coluna para o open office
------------------------------------------------------------------------------*/
DEFINE VARIABLE pos AS INTEGER NO-UNDO.
IF LENGTH(p_Col) = 1 THEN DO:
pos = asc(UPPER(p_Col)) - 65.
END.
ELSE DO:
pos = asc(UPPER(substring(p_Col,1,1))) - 64.
pos = pos * 25.
pos = pos + (asc(UPPER(substring(p_Col,2,1))) - 64).
END.
RETURN pos.
END FUNCTION.
/* ********************** Procedures *********************** */
PROCEDURE CleanUp :
/*------------------------------------------------------------------------------
Purpose: Limpar as com-handles
------------------------------------------------------------------------------*/
/* Release all the com handles */
IF chOffice <> ? THEN RELEASE OBJECT chOffice.
IF chWorkBook <> ? THEN RELEASE OBJECT chWorkBook.
IF chDesktop <> ? THEN RELEASE OBJECT chDesktop.
IF chWorkSheet <> ? THEN RELEASE OBJECT chWorkSheet.
ASSIGN
chOffice = ?
chWorkBook = ?
chDesktop = ?
chWorkSheet = ?.
END PROCEDURE.
PROCEDURE close_Office :
/*------------------------------------------------------------------------------
Purpose: Fechar o Office
------------------------------------------------------------------------------*/
IF PctMSOffice = FALSE THEN DO:
/* Close the workbook */
IF chWorkbook <> ? THEN chWorkbook:Close(TRUE).
/* Close the program */
IF chDesktop <> ? THEN chDesktop:TERMINATE().
END.
ELSE DO:
chOffice:quit(). /* Fechar Excel */
END.
IF chOffice <> ? THEN
RUN CleanUp.
END PROCEDURE.
PROCEDURE hide_office :
/*------------------------------------------------------------------------------
Purpose: Esconder o Office para montagem da planilha
------------------------------------------------------------------------------*/
DEF VAR chFrame AS COM-HANDLE NO-UNDO.
DEF VAR chWindow AS COM-HANDLE NO-UNDO.
DEF VAR chRect AS COM-HANDLE NO-UNDO.
IF PctMSOffice = FALSE THEN DO:
chFrame = chDesktop:getCurrentFrame().
chWindow = chFrame:getContainerWindow().
chRect = chWindow:setPosSize(1,1,1,1,15).
END.
ELSE DO:
chOffice:VISIBLE = false.
END.
END PROCEDURE.
PROCEDURE identifica_office :
/*------------------------------------------------------------------------------
Purpose: Identifica qual pacote office esta instalado.
------------------------------------------------------------------------------*/
/* Define objeto como uma aplicação Excel*/
CREATE "Excel.Application" chOffice NO-ERROR.
/* Se não tiver o MS office */
IF ERROR-STATUS:ERROR THEN DO:
/* Tenta conectar a uma instancia existente do OpenOffice */
CREATE "com.sun.star.ServiceManager" chOffice CONNECT NO-ERROR.
/* Se der erro tenta criar uma nova instancia */
IF ERROR-STATUS:GET-MESSAGE(1) <> "" THEN
CREATE "com.sun.star.ServiceManager" chOffice.
/* Inicia o OO desktop. Onde as planilhas são gerenciadas. */
chDesktop = chOffice:createInstance("com.sun.star.frame.Desktop").
END.
ELSE
PctMSOffice = TRUE.
END PROCEDURE.
PROCEDURE MS_office :
/*------------------------------------------------------------------------------
Purpose: Força a abertura do relatório com Microsoft Office.
------------------------------------------------------------------------------*/
/* Define objeto como uma aplicação Excel*/
CREATE "Excel.Application" chOffice NO-ERROR.
/* Se não tiver o MS office */
IF ERROR-STATUS:ERROR THEN DO:
MESSAGE
"Não foi identificada instalação do Microsoft Office"
VIEW-AS ALERT-BOX INFO BUTTONS OK.
RETURN.
END.
ELSE
PctMSOffice = TRUE.
END PROCEDURE.
PROCEDURE new_book :
/*------------------------------------------------------------------------------
Purpose: Cria BOOK (Dccumento) e cria uma nova worksheet (Planilha) .
------------------------------------------------------------------------------*/
IF PctMSOffice THEN DO:
chOffice:VISIBLE = true. /* Torna a planilha visivel novamente */
chWorkBook = chOffice:Workbooks:Add(). /* Adiciona uma nova pasta de trabalho */
chWorkSheet = chOffice:Sheets:Item(1).
END.
ELSE DO:
chWorkBook = chDesktop:loadComponentFromURL("private:factory/scalc", "_blank", 0, cc).
chWorkSheet = chWorkBook:Sheets:getByIndex(0).
END.
END PROCEDURE.
PROCEDURE open_book :
/*------------------------------------------------------------------------------
Purpose: Abre um BOOK (Dccumento) e a primeira worksheet (Planilha) .
------------------------------------------------------------------------------*/
DEF INPUT PARAM ip_FileName AS CHAR NO-UNDO. /* caminho da planilha */
IF PctMSOffice = FALSE THEN DO:
IF chWorkbook = ? THEN LEAVE.
ASSIGN
ip_FileName = "file:///" + TRIM(ip_FileName)
ip_FileName = REPLACE(ip_FileName, "\", "/").
chWorkbook = chDesktop:loadComponentFromURL(ip_FileName, "_blank", 0, cc).
chWorksheet = chWorkbook:Worksheets:Item(1).
END.
ELSE DO:
chWorkBook = chOffice:Workbooks:Add(ip_FileName). /* Adiciona uma pasta de trabalho existente */
chWorkSheet = chOffice:Sheets:Item(1). /* Aponta para planilha dentro da pasta de trabalho */
END.
END PROCEDURE.
PROCEDURE open_office :
/*------------------------------------------------------------------------------
Purpose: Força a abertura do relatório com Open Office.
------------------------------------------------------------------------------*/
/* Tenta conectar a uma instancia existente do OpenOffice */
CREATE "com.sun.star.ServiceManager" chOffice CONNECT NO-ERROR.
/* Se der erro tenta criar uma nova instancia */
IF ERROR-STATUS:GET-MESSAGE(1) <> "" THEN DO:
ERROR-STATUS:ERROR = FALSE.
CREATE "com.sun.star.ServiceManager" chOffice.
END.
/* Inicia o OO desktop. Onde as planilhas são gerenciadas. */
chDesktop = chOffice:createInstance("com.sun.star.frame.Desktop").
/* Se não tiver o MS office */
IF ERROR-STATUS:ERROR THEN DO:
MESSAGE
"Não foi identificada instalação do Open Office"
VIEW-AS ALERT-BOX INFO BUTTONS OK.
RETURN.
END.
PctMSOffice = FALSE.
END PROCEDURE.
PROCEDURE save_book :
/*------------------------------------------------------------------------------
Purpose: Salva a planilha gerada
------------------------------------------------------------------------------*/
DEF INPUT PARAM ip_OutputPath AS CHAR NO-UNDO. /* directory path */
DEF INPUT PARAM ip_FileName AS CHAR NO-UNDO. /* spreadsheet name */
DEF VAR chrFileName AS CHAR NO-UNDO.
ASSIGN chrFileName = ip_OutputPath.
IF SUBSTRING(chrFileName, LENGTH(chrFileName), 1) <> "\" THEN
ASSIGN chrFileName = chrFileName + "\".
ASSIGN chrFileName = chrFileName + ip_FileName.
IF chrFileName = ""
OR chrFileName = ? THEN DO:
MESSAGE
"Informe o caminho para salvar o arquivo"
VIEW-AS ALERT-BOX INFO BUTTONS OK.
RETURN.
END.
IF PctMSOffice = FALSE THEN DO:
ASSIGN
chrFileName = "file:///" + chrFileName + ".xls" /* O open office não consegue gerar xlsx */
chrFileName = REPLACE(chrFileName, "\\", "\")
chrFileName = REPLACE(chrFileName, "/\", "\")
chrFileName = REPLACE(chrFileName, "\", "/").
chWorkBook:storeAsURL(chrFileName, cc).
END.
ELSE DO:
ASSIGN chrFileName = chrFileName + ".xlsx".
MESSAGE
chrFileName
VIEW-AS ALERT-BOX INFO BUTTONS OK.
chWorkBook:SaveAs(chrFileName,,,,False,False,). /* Salvar documento */
END.
/* PAUSE 2. */
END PROCEDURE.
PROCEDURE set_font_style :
/*------------------------------------------------------------------------------
Purpose: Seta o estilo da fonte de uma celula
Parameters: Row #
Column #
Font Name
Size (points)
Bold (TRUE/FALSE)
Color index
Underline (See below)
------------------------------------------------------------------------------*/
DEF INPUT PARAM p_Col AS CHAR NO-UNDO. /* Coluna */
DEF INPUT PARAM p_Row AS INT NO-UNDO. /* Linha */
DEF INPUT PARAM ip_Font AS CHAR NO-UNDO. /* Font Name */
DEF INPUT PARAM ip_Size AS INT NO-UNDO. /* Point Size */
DEF INPUT PARAM ip_Bold AS LOG NO-UNDO. /* Bold (weight = 150 for bold, 100 for normal) */
DEF INPUT PARAM p_Color AS INT NO-UNDO. /* Color index */
DEF INPUT PARAM ip_Underline AS INT NO-UNDO. /* NONE = 0, SINGLE =1, DOUBLE=2, DOTTED = 3
DONTKNOW=4, DASH=5, LONGDASH=6, DASHDOT=7,
DASHDOTDOT=8, SMALLWAVE=9, WAVE =10, DOUBLEWAVE=11,
BOLD=12, BOLDDOTTED=13, BOLDLONGDASH= 14,
BOLDDASHDOT=15, BOLDDASHDOTDOT=16, BOLDWAVE = 17 */
DEFINE VARIABLE celula AS CHARACTER NO-UNDO.
DEFINE VARIABLE coluna AS INTEGER NO-UNDO.
IF PctMSOffice = FALSE THEN DO:
/* No OpenOffice as colunas e linhas iniciam em zero */
ASSIGN
p_Row = p_Row - 1
coluna = getPosColuna(p_Col).
IF p_Row < 0 THEN ASSIGN p_Row = 0.
/* Seta os atributos da fonte */
IF ip_Font > "" THEN chWorkSheet:GetCellByPosition(coluna,p_Row):CharFontName = ip_Font.
IF ip_Size > 0 THEN chWorkSheet:GetCellByPosition(coluna,p_Row):CharHeight = ip_Size.
IF ip_Bold THEN chWorkSheet:GetCellByPosition(coluna,p_Row):CharWeight = 150.
IF ip_Underline > 0 THEN chWorkSheet:GetCellByPosition(coluna,p_Row):CharUnderline = ip_UnderLine.
IF p_Color > 0 THEN chWorkSheet:GetCellByPosition(coluna,p_Row):CharColor = p_Color.
END.
ELSE DO:
IF p_Row < 1 THEN ASSIGN p_Row = 1.
ASSIGN
celula = p_Col + STRING(p_Row)
ip_Underline = ip_Underline - 1.
IF ip_Font > "" THEN chWorksheet:Range(celula):Font:NAME = ip_Font.
IF ip_Size > 0 THEN chWorksheet:Range(celula):Font:size = ip_Size. /* Tamanho da fonte */
IF ip_Bold THEN chWorksheet:Range(celula):Font:Bold = ip_Bold. /* Negrito */
IF ip_Underline > 0 THEN chWorksheet:Range(celula):Font:Underline = ip_Underline. /* Sublinhar texto */
IF p_Color > 0 THEN chWorksheet:Range(celula):Font:colorindex = p_Color. /* Cor da fonte */
END.
END PROCEDURE.
PROCEDURE set_function :
/*------------------------------------------------------------------------------
Purpose: Grava uma função Excel na celula,
se atente se está usando versão pt-BR ou ingres pois pode ser =SOMA() ou =SUM()
------------------------------------------------------------------------------*/
DEF INPUT PARAM p_Col AS CHAR NO-UNDO. /* Coluna */
DEF INPUT PARAM p_Row AS INT NO-UNDO. /* Linha */
DEF INPUT PARAM ip_Function AS CHAR NO-UNDO. /* Informação */
DEFINE VARIABLE celula AS CHARACTER NO-UNDO.
DEFINE VARIABLE coluna AS INTEGER NO-UNDO.
IF PctMSOffice = FALSE THEN DO:
/* No OpenOffice as colunas e linhas iniciam em zero */
ASSIGN
p_Row = p_Row - 1
coluna = getPosColuna(p_Col).
IF p_Row < 0 THEN ASSIGN p_Row = 0.
chWorkSheet:GetCellByPosition(coluna,p_Row):SetFormula(ip_Function).
END.
ELSE DO:
IF p_Row < 1 THEN ASSIGN p_Row = 1.
ASSIGN celula = p_Col + STRING(p_Row).
chWorksheet:Range(celula):VALUE = ip_Function. /* Insere conteudo na célula */
END.
END PROCEDURE.
PROCEDURE show_office :
/*------------------------------------------------------------------------------
Purpose: Maximmiza a tela do Office
------------------------------------------------------------------------------*/
DEF VAR chFrame AS COM-HANDLE NO-UNDO.
DEF VAR chWindow AS COM-HANDLE NO-UNDO.
DEF VAR chRect AS COM-HANDLE NO-UNDO.
IF PctMSOffice = FALSE THEN DO:
chFrame = chDesktop:getCurrentFrame().
chWindow = chFrame:getContainerWindow().
chRect = chWindow:setPosSize(1,1,800,600,15).
END.
ELSE DO:
chOffice:VISIBLE = TRUE.
END.
END PROCEDURE.
PROCEDURE write_cell_header :
/*------------------------------------------------------------------------------
Purpose: Escreve cabeçalho na celula com tamanho 12 em negrito
------------------------------------------------------------------------------*/
DEF INPUT PARAM p_Col AS CHAR NO-UNDO. /* Coluna */
DEF INPUT PARAM p_Row AS INT NO-UNDO. /* Linha */
DEF INPUT PARAM p_Data AS CHAR NO-UNDO. /* Informação */
DEFINE VARIABLE celula AS CHARACTER NO-UNDO.
DEFINE VARIABLE coluna AS INTEGER NO-UNDO.
RUN set_font_style(p_Col,p_Row,'',12,TRUE,0,0). /* Fonte 12 negrito */
IF PctMSOffice = FALSE THEN DO:
/* No OpenOffice as colunas e linhas iniciam em zero */
ASSIGN
p_Row = p_Row - 1
coluna = getPosColuna(p_Col).
IF p_Row < 0 THEN ASSIGN p_Row = 0.
chWorkSheet:GetCellByPosition(coluna,p_Row):STRING = p_Data.
END.
ELSE DO:
IF p_Row < 1 THEN ASSIGN p_Row = 1.
ASSIGN celula = p_Col + STRING(p_Row).
/* Insere conteudo na célula */
chWorksheet:Range(celula):VALUE = p_Data.
END.
END PROCEDURE.
PROCEDURE write_cell_number :
/*------------------------------------------------------------------------------
Purpose: Escreve um numero na celula
------------------------------------------------------------------------------*/
DEF INPUT PARAM p_Col AS CHAR NO-UNDO. /* Column Number */
DEF INPUT PARAM p_Row AS INT NO-UNDO. /* Row Number */
DEF INPUT PARAM p_Data AS DEC NO-UNDO.
DEFINE VARIABLE celula AS CHARACTER NO-UNDO.
DEFINE VARIABLE coluna AS INTEGER NO-UNDO.
IF PctMSOffice = FALSE THEN DO:
/* No OpenOffice as colunas e linhas iniciam em zero */
ASSIGN
p_Row = p_Row - 1
coluna = getPosColuna(p_Col).
IF p_Row < 0 THEN ASSIGN p_Row = 0.
chWorkSheet:GetCellByPosition(coluna,p_Row):VALUE = p_Data.
END.
ELSE DO:
IF p_Row < 1 THEN ASSIGN p_Row = 1.
ASSIGN celula = p_Col + STRING(p_Row).
/* Insere conteudo na célula */
chWorksheet:Range(celula):VALUE = p_Data.
END.
END PROCEDURE.
PROCEDURE write_cell_text :
/* Purpose: Write text into a cell . */
/*------------------------------------------------------------------------------
Purpose: Escreve um texto na celula
------------------------------------------------------------------------------*/
DEF INPUT PARAM p_Col AS CHAR NO-UNDO. /* Coluna */
DEF INPUT PARAM p_Row AS INT NO-UNDO. /* Linha */
DEF INPUT PARAM p_Data AS CHAR NO-UNDO. /* Informação */
DEFINE VARIABLE celula AS CHARACTER NO-UNDO.
DEFINE VARIABLE coluna AS INTEGER NO-UNDO.
IF PctMSOffice = FALSE THEN DO:
/* No OpenOffice as colunas e linhas iniciam em zero */
ASSIGN
p_Row = p_Row - 1
coluna = getPosColuna(p_Col).
IF p_Row < 0 THEN ASSIGN p_Row = 0.
chWorkSheet:GetCellByPosition(coluna,p_Row):STRING = p_Data.
END.
ELSE DO:
IF p_Row < 1 THEN ASSIGN p_Row = 1.
ASSIGN celula = p_Col + STRING(p_Row).
/* Insere conteudo na célula */
chWorksheet:Range(celula):VALUE = p_Data.
END.
END PROCEDURE.
Para usar este recurso, salve o código como geraPlanilha.i e insira como recurso no programa: {geraPlanilha.i}
Para gerar uma planilha Excel ou Calc, use os seguintes comandos:
RUN identifica_office. /* Idenficica qual office esta instalado e o usa para gerar planilha */
RUN MS_office. /* Faz geração de planilha com Microsoft Office */
RUN open_office. /* Faz geração de planilha com Open Office */
RUN new_book. /* Gera Planilha nova */
RUN open_book(filename). /* Abre uma planilha passada por parametro */
RUN hide_office. /* Esconde a planilha enquanto gera os dados */
RUN write_cell_header(coluna,linha,texto). /* Registra o conteúdo com destaque, tamanho da fonte 12 e em negrito */
RUN write_cell_text(coluna,linha,texto). /* Informe o conteúdo */
RUN write_cell_number(coluna,linha,number). /* Informe o conteúdo da celula, vai converter para decimal */
RUN SET_function(coluna,linha,"=sum(B2:C2)"). /* Grava uma função na célula */
RUN set_font_style(coluna,linha,'Arial',16,TRUE,6,2). /* Altera o estilo da fonte */
RUN save_book("C:\Fabiano\","teste"). /* Salva o documento no diretório informado */
RUN show_office. /* Mostra a planilha */
RUN CleanUp. /* Faz limpeza do cache */
RUN close_Office. /* Fecha o office aberto e faz limpeza do cache */Esta include foi criada graças a várias publicações da comunidade, vou listar alguns link que usei de base para cria-la:
DevMedia: Trabalhando com Excel
Google Groups: OpenEdge Excel Library
Qualquer dica ou melhoria que possa recomendar vou incluir no código deste post.
