Exportar para excel com Abas
Enviado: 28 Mar 2017 13:00
Obrigado Toledo e Paredes
Isso funcionou, ficou perfeito:
Mas Isso travou a execução:
Isso tb travou a execução:
Segue o código q estou usando. É uma mescla do que foi postado aqui no fórum por Toledo e pelo Fladimir ...
: 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 ?
Isso funcionou, ficou perfeito:
Código: Selecionar todos
oSheet:Cells( 2, 1 ):Value := "'"+"003ACAD"Código: Selecionar todos
oExcel:ActiveWindow:FreezePanes := .t.Código: Selecionar todos
oSheet:Range("C3"):Select()
oExcel:ActiveWindow:FreezePanes = .T.
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