Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Export eliminating the zeros
Message
From
20/01/2011 11:07:44
 
General information
Forum:
Visual FoxPro
Category:
COM/DCOM and OLE Automation
Environment versions
Visual FoxPro:
VFP 9 SP1
OS:
Windows XP SP2
Network:
Windows 2003 Server
Database:
MS SQL Server
Application:
Desktop
Miscellaneous
Thread ID:
01496691
Message ID:
01496693
Views:
34
ccursor='transacciones2'
lnombre='VENTAS'
cfilesave=''
ctitulo='REPORTE DE VENTAS Y SERVICIOS 607'
select transacciones2
go top
scan
	xrnc=strtran(rnc,"-","")
	xw=11-len(alltrim(xrnc))
	if len(alltrim(rnc))<8
		xrnc=''
		xw=11
	endif
	replace rnc with xrnc
endscan
select transacciones2
go bott

*********************************
*** Creación del Objeto Excel ***
*********************************
wait window 'Abriendo aplicación Excel.' nowait noclear
oexcel = createobject("Excel.Application")
wait clear

if type('oExcel') # 'O'
	messagebox("No se puede procesar el archivo porque no tiene la aplicación" ;
		+ chr(13) + "Microsoft Excel instalada en su computador.",16,cwarning)
	return .f.
endif

oexcel.workbooks.add

local lnrecno, lnpos, lnpag, lncuantos, lnrowtit, lnrowpos, i, lnhojas, cdefault

cdefault = addbs(sys(5)  + sys(2003))

select (ccursor)
lnrecno = recno(ccursor)
go top

*************************************************
*** Verifica la cantidad de hojas necesarias  ***
*** en el libro para la cantidad de datos     ***
*************************************************
lnhojas = round(reccount(ccursor)/65000,0)
do while oexcel.sheets.count < lnhojas
	oexcel.sheets.add
enddo

lnpos = 0
lnpag = 0

do while lnpos < reccount(ccursor)

	lnpag = lnpag + 1 && Hoja que se está procesando

	wait windows 'Exportando cursor '  + upper(ccursor)  + ' a Microsoft Excel...' ;
		+ chr(13) + '(Hoja '  + alltrim(str(lnpag))  + ' de '  + alltrim(str(lnhojas)) ;
		+ ')' noclear nowait

	if file(cdefault  + ccursor  + ".txt")
		delete file (cdefault  + ccursor  + ".txt")
	endif

	copy  next 65000 to (cdefault  + ccursor  + ".txt") delimited with character ";"
	lnpos = recno(ccursor)
	oexcel.sheets(lnpag).select

	xlsheet = oexcel.activesheet
	xlsheet.name = ccursor + '_' + alltrim(str(lnpag))

	lncuantos = afields(acampos,ccursor)
********************************************************
*** Coloca título del informe (si este es informado) ***
********************************************************
	if !empty(ctitulo)
		xlsheet.cells(1,1).font.name = "Arial"
		xlsheet.cells(1,1).font.size = 12
		xlsheet.cells(1,1).font.bold = .t.
		xlsheet.cells(1,1).value = ctitulo
		xlsheet.range(xlsheet.cells(1,1),xlsheet.cells(1,lncuantos)).mergecells = .t.
		xlsheet.range(xlsheet.cells(1,1),xlsheet.cells(1,lncuantos)).merge
		xlsheet.range(xlsheet.cells(1,1),xlsheet.cells(1,lncuantos)).horizontalalignment = 3
		lnrowpos = 3
	else
		lnrowpos = 2
	endif

	lnrowtit = lnrowpos - 1
**********************************
*** Coloca títulos de Columnas ***
**********************************
	for i = 1 to lncuantos
		lcname  = acampos(i,1)
		lccampo = alltrim(ccursor) + '.' + acampos(i,1)
		xlsheet.cells(lnrowtit,i).value=lcname
		xlsheet.cells(lnrowtit,i).font.bold = .t.
		xlsheet.cells(lnrowtit,i).interior.colorindex = 15
		xlsheet.cells(lnrowtit,i).interior.pattern = 1
		xlsheet.range(xlsheet.cells(lnrowtit,i),xlsheet.cells(lnrowtit,i)).borderaround(7)
	next

	xlsheet.range(xlsheet.cells(lnrowtit,1),xlsheet.cells(lnrowtit,lncuantos)).horizontalalignment = 3

*************************
*** Cuerpo de la hoja ***
*************************
	oconnection = xlsheet.querytables.add("TEXT;"  + cdefault  + ccursor  + ".txt", ;
		xlsheet.range("A"  + alltrim(str(lnrowpos))))

	with oconnection
		.name = ccursor
		.fieldnames = .t.
		.rownumbers = .f.
		.filladjacentformulas = .f.
		.preserveformatting = .t.
		.refreshonfileopen = .f.
		.refreshstyle = 1 && xlInsertDeleteCells
		.savepassword = .f.
		.savedata = .t.
		.adjustcolumnwidth = .t.
		.refreshperiod = 0
		.textfilepromptonrefresh = .f.
		.textfileplatform = 850
		.textfilestartrow = 1
		.textfileparsetype = 1 && xlDelimited
		.textfiletextqualifier = 1 && xlTextQualifierDoubleQuote
		.textfileconsecutivedelimiter = .f.
		.textfiletabdelimiter = .t.
		.textfilesemicolondelimiter = .t.
		.textfilecommadelimiter = .f.
		.textfilespacedelimiter = .f.
		.textfiletrailingminusnumbers = .t.
		.refresh
	endwith

	xlsheet.range(xlsheet.cells(lnrowtit,1),xlsheet.cells(xlsheet.rows.count,lncuantos)).font.name = "Arial"
	xlsheet.range(xlsheet.cells(lnrowtit,1),xlsheet.cells(xlsheet.rows.count,lncuantos)).font.size = 9

	xlsheet.columns.autofit
	xlsheet.columns("D").numberformat = "@"
	xlsheet.columns("I").numberformat = "#,##0.00"
	xlsheet.columns("J").numberformat = "#,##0.00"
	xlsheet.columns("K").numberformat = "#,##0.00"
	xlsheet.columns("l").numberformat = "#,##0.00"
	xlsheet.columns("P").numberformat = "#,##0.00"

	xlsheet.cells(lnrowpos,1).select
	oexcel.activewindow.freezepanes = .t.

	wait clear

enddo
Jose Manuel Ramirez
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform