Exportar para excel com Abas

[lugab]

Obrigado Toledo e Paredes
Isso funcionou, ficou perfeito:

Código: Selecionar todos

 oSheet:Cells( 2, 1 ):Value := "'"+"003ACAD"

Mas Isso travou a execução:

Código: Selecionar todos

oExcel:ActiveWindow:FreezePanes := .t.

Isso tb travou a execução:

Código: Selecionar todos

oSheet:Range("C3"):Select()
oExcel:ActiveWindow:FreezePanes = .T.

Segue o código q estou usando. É uma mescla do que foi postado aqui no fórum por Toledo e pelo Fladimir ...

Código: Selecionar todos

** Teste de geração em XLS
#define CRLF CHR(13)+CHR(10)
GLOBAL oApp
static s_amiscobjlist := {}

function main
LOCAL oExcel, oSheet 
local aEnv
local getlist:={}
Request Hb_Lang_Pt
Hb_Langselect("PT")
set deleted on
set date british
set scoreboard off
set bell off
set dele on
set excl off
set fixe off
set exac off
set century on
set epoch to 2000
setcancel(.f.)
ksetcaps(.t.)

Request dbfcdx
Rddsetdefault("dbfcdx")
*-------------------------------
Sele 200
Use estp01 alias ESTOQUE
*--------------------------
oExcel := TOleAuto():New( "Excel.Application" )
oExcel:WorkBooks:Add()
oSheet := oExcel:Get( "ActiveSheet" )
if (oExcel := Cria_OLE("Excel.Application", "Erro! O Excel esta inativado ou desinstalado nesse Computador", .T.) ) == NIL
   return
endif
  
oExcel:WorkBooks:Add()
oSheet := oExcel:ActiveSheet

oSheet:Name := 'Analise Geral' 
oSheet:Cells( 1, 1 ):Value := "Referencia"
oSheet:Cells( 1, 2 ):Value := "Descricao"
oSheet:Cells( 1, 3 ):Value := "Prelis"
oSheet:Cells( 1, 4 ):Value := "Preven"

 for i=1 to 4 
   oSheet:Cells( 1, i ):Font:Bold     := .T.
   oSheet:Cells( 1, i ):Font:ColorIndex  := 2  //-- Cor da letra
   oSheet:Cells( 1, i ):Interior:ColorIndex := 11  //-- Cor de Fundo
   oSheet:Cells( 1, i ):HorizontalAlignment := -4108 // Alinhamento Centro
   oSheet:Columns(i):ColumnWidth := 20 // era 15 ,Tamanho da Coluna
 NEXT
** Tamanho da Coluna
oSheet:Columns(1):ColumnWidth := 15 // 3.86
oSheet:Columns(2):ColumnWidth := 25 //  40
oSheet:Columns(3):ColumnWidth := 15 //40
oSheet:Columns(4):ColumnWidth := 15 // 7

*** Cor da letra:
oSheet:Cells( 1, 1 ):Font:ColorIndex := 3
*** Cor de Preenchimento:
oSheet:Cells( 1, 2 ):Interior:ColorIndex := 7

*** se quiser Colocar Bordas:
oSheet:Range("A2:M10"):Borders(1):LineStyle:= 1
oSheet:Range("A2:M10"):Borders(2):LineStyle:= 1
oSheet:Range("A2:M10"):Borders(3):LineStyle:= 1
oSheet:Range("A2:M10"):Borders(4):LineStyle:= 1

 oSheet:Cells( 1, 1 ):Select()
 oExcel:Visible := .F.
 nLinPlan := 2
 nTotValor :=0 
 sele estoque
 Do while .not. eof() // .and. lidos<20
   oSheet:Cells( nLinPlan, 1 ):Value := "'"+Estoque->ref
   oSheet:Cells( nLinPlan, 2 ):Value := Alltrim(Estoque->DESREF)
   oSheet:Cells( nLinPlan, 3 ):Value := Estoque->Preven
   oSheet:Cells( nLinPlan, 4 ):Value := Estoque->Prelis
   nTotValor += Estoque->PreVen

   oSheet:Cells( nLinPlan, 1 ):HorizontalAlignment := 1 //-- Esquerda
   oSheet:Cells( nLinPlan, 2 ):HorizontalAlignment := 3 //-- Centro
   oSheet:Cells( nLinPlan, 3 ):HorizontalAlignment := 3 //-- Centro
   oSheet:Cells( nLinPlan, 4 ):HorizontalAlignment := 3 //-- Centro

   oSheet:Cells( nLinPlan, 3 ):NumberFormat := "#.##0,00"
   oSheet:Cells( nLinPlan, 4 ):NumberFormat := "#.##0,00"
                
   nLinPlan++
   skip
END
 * Retrieve the FileFormat
 nFileFormat = oExcel:WorkBooks(1):FileFormat
 cArq := 'd:\max\xexcel\BCZ.xls' 
 Ferase( cArq)
 oSheet:SaveAs( cArq, 56 )
 oExcel:WorkBooks:Close()
 oExcel:Quit()
 oExcel := NIL // Libera o Excel
 dbcloseall()
 ShellExecute(cArq,"open",nil,,1) 
RETURN

*---------------------------------------------- 
function Cria_OLE(cObj_OLE, cMsg, lGetActiveObj)
*---------------------------------------------- 
 local oObj_OLE := NIL
*** Linhas abaixo deram erro
** DEFAULT cMsg TO 'Erro ao tentar carregar objeto;;Tente novamente'
**  DEFAULT lGetActiveObj TO .F.
cMsg='Erro ao tentar carregar objeto, tente novamente'
lGetActiveObj=.F.

 if lGetActiveObj
  TRY
    oObj_OLE := GetActiveObject( cObj_OLE )
  CATCH
   TRY
    oObj_OLE := CREATEOBJECT(cObj_OLE)
   CATCH
    alert(cMsg, {'Ok'}, vcw)
    return NIL //oObj_OLE
   END
  END
 else
  TRY
   oObj_OLE := CREATEOBJECT(cObj_OLE)
  CATCH
   Alert(cMsg)
   return oObj_OLE
  END
 endif 
 
return oObj_OLE

: PS: Algo está gerando uma tela preta - igualzinha a janela padrão do DOS - durante a execução desse código. O que pode ser ?

[Jairo Maia]

[Editado]

: PS: Algo está gerando uma tela preta - igualzinha a janela padrão do DOS - durante a execução desse código. O que pode ser ?

Provavelmente está faltando o parâmetro "-gui" na compilação.

[lugab]

Oi, Jairo, obrigado pela assistência

O Xharbour que uso, possui hbmake.exe em vez de hbmk2.exe. É a versão "xHarbour 1.0 para BCC 5.5" (link abaixo).
http://www.vagucs.com.br/cgi-bin/vagucs ... dioma=ptbr
Estou preso a essa versão, pq uso a lib "vlx_jan.lib " do Wagner, que só funciona nessa versão..

A solução que dei foi um armengue, que até ficou legal: joguei uma cor na tela preta e exibi mensagens gerais

[tonicm]

Como se faz para saber quantas linhas e colunas tem um ficheiro excel?

[asimoes]

Código: Selecionar todos

nLinhas  := oSheet1:UsedRange():Rows():Count //Total de linhas uasadas
nColunas := oSheet1:UsedRange():Columns():Count //Total de colunas usadas

[JoséQuintas]

Lembrando que talvez seja interessante acessar Excel por ADO.
Neste caso seria testar RecCount() e Fields:Count()

[asimoes]

Quintas,

Tem algum exemplo acessando excel por ado ?

[JoséQuintas]

Lembro de ter feito também a gravação de planilha Excel, mas não encontrei ainda.
No caso da gravação, requer primeiro criar a planilha pra depois conectar pelo ADO, então nesta parte tem algo mais específico pra planilha.

Aqui uma leitura "universal", onde primeiro pega os nomes das planilhas pra depois ler por comandos SQL.
Pode não ficar muito claro o fonte, porque é pra gerar código fonte em PRG, o que é um uso de certa forma mais avançado com fonte não muito comum.

https://github.com/JoseQuintas/JoseQuin ... stoprg.prg

É ler qualquer planilha, e gerar um código fonte em PRG pra criar um array com o conteúdo da planilha.

[tonicm]

Obrigado José Quintas.

[JoséQuintas]

Correção do meu texto: o fonte pega de vários arquivos, mas só pega da primeira planilha.

Código: Selecionar todos

FUNCTION ExcelSheetName( cn )
   LOCAL cSheetName, Rs
   rs := cn:OpenSchema( AD_SCHEMA_TABLES )
   cSheetName := rs:Fields( "TABLE_NAME" ):Value
   rs:Close()

Nessa parte só pega o primeiro nome.
Caso um arquivo XLS tenha mais planilhas, teria que alterar a rotina.
Isso é parecido com DBF, vários registros, e na rotina só pega o primeiro registro, a primeira planilha.
Ficaria assim pra todas:

Código: Selecionar todos

aPlanilhaList := {}
DO WHILE ! Rs:Eof()
   AAdd( aPlanilhaList, rs:Fields( "TABLE_NAME" ):Value )
   Rs:MoveNext()
ENDDO
rs:Close()
RETURN aPlanilhaList

Depois processar cada elemento do array, igual a rotina faz.

Código: Selecionar todos

FOR EACH oElement IN aPlanilhaList
   ProcessaPlanilha( oElement )
NEXT

[asimoes]

Estou com um erro intermitente, ora abre a planilha ora dá a mensagem :

Código: Selecionar todos

Error WINOLE/1007  A tabela externa não está no formato esperado. (0x80004005): Microsoft JET Database Engine (DOS Error -2147352567)
Called from ->WIN_OLEAUTO:OPEN(0)

Estou abrindo uma planilha xlsx

[JoséQuintas]

Confirme a string, pode ter mais formatos de excel.

oConexao:ConnectionString := ;
[Provider=Microsoft.Jet.OLEDB.4.0;Data Source=] + cFileName + ;
[;Extended Properties="] + iif( ".xlsx" $ cFileName, [Excel.12.0 Xml], [Excel 8.0] ) + [";] // HDR=Yes;IMEX=1";

Repare que XLS e XLSX são versões de Excel diferentes.

[asimoes]

Quintas,

A string de conexão é a que você informou, agora o teste aqui em casa, windows 10 64 o erro é outro:

2017-08-23 20_19_42-Relação de Aniversariantes da SMF.png (11.38 KiB) Exibido 10607 vezes

Precisa instalar o driver ? qual ?

[JoséQuintas]

Tem mais strings aqui

https://www.connectionstrings.com/excel/

[Paredes01]

Hola, saludos a todos

Cuando necesito leer un catalogo de excel e insertarlo a mi tabla de articulos
lo hago de esta forma con ADO.

#include "ado.ch"
#include "Fileio.ch"
#INCLUDE "INKEY.CH"
#include 'hbgtinfo.ch'
#include "sqlrdd.ch"

REQUEST SQLEX
REQUEST SR_ODBC

REQUEST DBFNTX
REQUEST DBFDBT

REQUEST HB_GT_WVT_DEFAULT
REQUEST HB_LANG_ES

Procedure Main()
Local oConn, oComm, oRs, oErr
Local cPath := CurDrive() +":\"+ CurDir() + "\"
Local cTemp := cPath
Local cConn := "", cTest, cState
Local cFile := "catalogo.xlsx"

Local hDatos := Hash()

Local apCode
Local cCommand
Local cResult
Local nCnn, i

HSetAACompatibility(hDatos, .T.)

#pragma TEXTHIDDEN(1)
hDatos["Myip"] := "xxx.xxx.xxx.xxx"
hDatos["MyPort"] := ",1433"
hDatos["MyDatabase"]:= "mybase"
hDatos["MyDNS"] := "mybase"
hDatos["UserName"] := "sa"
hDatos["Password"] := "***********"
#pragma TEXTHIDDEN(0)

RDDSetDefault("SQLRDD")

HB_LANGSELECT('ES')

HB_GTInfo( HB_GTI_FONTNAME, "Consolas" )
HB_GTInfo( HB_GTI_FULLSCREEN, .T. )
HB_GTInfo( HB_GTI_CLOSABLE, .F. )

HB_gtInfo(HB_GTI_CLIPBOARDDATA )
HB_gtInfo(HB_GTI_SELECTCOPY, .T. )
HB_gtInfo(HB_GTI_MOUSESTATUS, 1 )

SET AUTOPEN OFF
SET AUTOSHARE TO 1
SET TALK OFF
SET STATUS OFF
SET ECHO OFF
SET CONFIRM OFF
SET BELL OFF
SET DELETED ON
SET SCORE OFF
SET SAFETY OFF
SET SCOREBOARD OFF
SET CENTURY ON
SET EPOCH TO 1960
SET DATE FORMAT TO "DD/MM/YYYY"
SET DATE FRENCH

SETCANCEL(.F.)

SETMODE(25,80)
Cls

Try
cCon:="Driver=SQL Server;NetWork Library=DBMSSocn;Server="+hDatos["Myip"]+hDatos["MyPort"]+";DataBase="+hDatos["MyDatabase"]+";uid="+hDatos["UserName"]+";pwd="+hDatos["Password"]

SR_SETSQL2008NEWTYPES(.F.)
nCnn := SR_AddConnection(CONNECT_ODBC, cCon )

if nCnn <= 0
Alert("Fallo de conexión ...")
SR_EndConnection(nCnn)
CLS
QUIT
endIf
Catch
Alert("No se conecta ...")
SR_EndConnection(nCnn)
CLS
QUIT
End

Public aArti :={}
Public cFactura

USE Articulo Shared New

*- esto es con ADO
cConn+= 'Provider=Microsoft.ACE.OLEDB.12.0;'
cConn+= 'Data Source=' + cPath + cFile + ';'
cConn+= 'Extended Properties="Excel 12.0;HDR=No;IMEX=1";'

Try
oConn:=CreateObject( "ADODB.Connection" )
With object oConn

:ConnectionString:=cConn
:Open()
cState:= oConn:State
@ 22,01 say "Estatus : " + iif(cState = 0, "Desconectado","Conectado ")
End

oComm:=CreateObject( "ADODB.Command" )
With object oComm
:CommandText:="select * from [productos$]" // <----- nombre de la pestaña
:CommandType:=adCmdText
:ActiveConnection:=oConn
oRs:=:Execute()
End

With object oRs

For i:=1 to 1 // Brincamos la priemra línea
:MoveNext()
Next

nNum := 0
cNum := ""
Do while !:Eof()
nNum++
cNum := strzero(nNum,6)

cHrae := space(13)
cComercial := Space(120)
cFormula := Space(120)
cPresentacion := Space(15)
nPrecioM := 0
cIdCve := Space(8)
cEAN := Space(14)
cLabora := Space(12)
cTiva := Space(1)

// Asignamos columnas de excel a variables
cHrae := Alltrim( :Fields(2):Value)
cComercial := Alltrim( :Fields(8):Value)
cFormula := Alltrim( :Fields(3):Value)
cPresentacion := Alltrim( :Fields(4):Value)

nPrecioM := VAL(STRTRAN(oRs:Fields(6):Value,','))
cIdCve := Alltrim( :Fields(7):Value)
cEAN := Alltrim( :Fields(9):Value)
cLabora := Alltrim( :Fields(10):Value)
cTiva := Alltrim( :Fields(11):Value)
cArticu00 := cNum
cArticu22 := cNum
cLinea := "FAMC"
cIMSS := SubStr(cHRAE,1,10)

DBSelectar("Articulo")
DBAppend()
REPLACE ARTICU00 WITH cArticu00
REPLACE ARTICU22 WITH cArticu22
REPLACE ARTICU01 WITH cComercial
REPLACE ARTICU02 WITH nPrecioM
REPLACE ARTICU03 WITH nPrecioM
REPLACE ARTICU04 WITH nPrecioM
REPLACE ARTICU05 WITH nPrecioM
REPLACE ARTICU06 WITH cTiva
REPLACE ARTICU10 WITH cEAN
REPLACE ARTICU11 WITH cLinea
REPLACE ARTICU21 WITH cLabora
REPLACE Formula WITH cFormula
REPLACE idMedsur WITH cIdCve
REPLACE Formula WITH cFormula
REPLACE IdHRAE WITH cHRAE
REPLACE idIMSS WITH cIMSS
REPLACE unidad WITH SubStr(cPresentacion,1,5)
REPLACE presentacion WITH cPresentacion
DBCommit()

:MoveNext()
Enddo
End

oRs:Close()
oConn:Close()
oRs:=NIL
oComm:=NIL
oConn:=NIL
Articulo->(DBCloseArea())
Catch oErr
Alert( "Error: " + oErr:Operation + " " + oErr:Description )
End
Return

Saludos