Como convierto un DBF a Excel
Moderator: Rathinagiri
-
- Posts: 388
- Joined: Wed Nov 21, 2012 7:14 pm
- Location: México
Re: Como convierto un DBF a Excel
Si ve alguien si ven mi rutina???
Gracias
Polo
Gracias
Polo
-
- Posts: 388
- Joined: Wed Nov 21, 2012 7:14 pm
- Location: México
Re: Como convierto un DBF a Excel
No encuentro....
Code: Select all
/*
* HMG ReadXLS Demo
* Contributed by Isma Elias <farfa890@gmail.Com> y Leopoldo Blancas jijiji
*/
#include "MiniGUI.ch"
#include "Dbstruct.ch"
#define NTrim( n ) LTRIM( STR( n, IF( n == INT( n ), 0, 2 ) ) )
#define TRUE .T.
#define FALSE .F.
Static aNamis := {}
Static aFila := {}
Static aWitis := {}
Static aHojita := {}
Static nWcrt := 0
Static nHcrt := 0
Function Main()
PRIVATE cArchivo := ''
PRIVATE aTypeCol:={}
PRIVATE nFilas := 0
PRIVATE nnColumn := 0
PRIVATE aStruct
PRIVATE nTotalReg
nWcrt := GetDesktopWidth()
nHcrt := GetDesktopHeight()-28
DEFINE WINDOW WinMain ;
AT 0,0 WIDTH nWcrt HEIGHT nHcrt ;
TITLE 'LEER UN EXCEL o un DBF a EXCEL!!!! ' ;
MAIN
@050,001 GRID Grid_1 WIDTH nWcrt-03 HEIGHT nHcrt-100 ;
FONT "Ms Sans Serif" SIZE 09 ;
HEADERS { "" } ;
WIDTHS { 100 } ;
ITEMS { { "" } };
VALUE 1
DEFINE BUTTON cmdxls
ROW 015
COL 005
WIDTH 98
HEIGHT 24
CAPTION "&Abrir XLS"
FONTNAME "Ms Sans Serif"
FONTSIZE 9
ACTION FAR_OpenXLS()
FLAT .T.
END BUTTON
DEFINE LABEL Label_1
ROW 018
COL 105
WIDTH 190
HEIGHT 24
VALUE "Nombre del Archivo *.DBF :"
FONTNAME "Ms Sans Serif"
FONTSIZE 9
FONTBOLD .T.
END LABEL
DEFINE TEXTBOX TextBox_1
ROW 015
COL 265
WIDTH 98
HEIGHT 24
FONTNAME "Ms Sans Serif"
FONTSIZE 9
END TEXTBOX
DEFINE BUTTON Boton_2
ROW 015
COL 365
WIDTH 98
HEIGHT 24
CAPTION "Grabar a DBF"
FONTNAME "Ms Sans Serif"
FONTSIZE 9
ACTION GrabaDBF()
FLAT .T.
END BUTTON
DEFINE LABEL Label_2
ROW 015
COL nWcrt-150
WIDTH 190
HEIGHT 24
VALUE ""
FONTNAME "Ms Sans Serif"
FONTSIZE 14
FONTBOLD .T.
END LABEL
DEFINE BUTTON Boton_3
ROW 015
COL 545
WIDTH 120
HEIGHT 24
CAPTION "Abrir DBF a Excel"
FONTNAME "Ms Sans Serif"
FONTSIZE 9
ACTION FAR_OpenDBF()
FLAT .T.
END BUTTON
DEFINE LABEL Label_3
ROW 015
COL nWcrt-350
WIDTH 190
HEIGHT 25
VALUE "Total de Registros:"
FONTNAME "Ms Sans Serif"
FONTSIZE 14
FONTBOLD .T.
END LABEL
END WINDOW
WinMain.Maximize()
ACTIVATE WINDOW WinMain
Return Nil
*--------------------------------------------------------------------------------------------------------------------------------------------------
Static Function FAR_OpenXLS()
LOCAL ccFile
if EMPTY(ccFile) .or. ccFile==NIL .or. LEN(ccFile)=0 .or. !file(ccFile)
ccFile := getfile({{"Archivos excel (*.xls)","*.xls"}},"Seleccione un archivo excel",GetCurrentFolder(),.f.)
endif
if EMPTY(ccFile) .or. ccFile==NIL .or. LEN(ccFile)=0 .or. !file(ccFile)
return nil
endif
cArchivo := SUBSTR(ccFile,RAT("\",ccFile)+1)
cArchivo := SUBSTR(cArchivo,1,RAT(".",cArchivo)-1)
WinMain.TextBox_1.VALUE := cArchivo
* MsgBox(cArchivo)
Load_XLS_CLI( ccFile )
WinMain.TextBox_1.VALUE := ccFile
Return Nil
*--------------------------------------------------------------------------------------------------------------------------------------------------------
Static Function Load_XLS_CLI( cArchivo )
* LOCAL nFilas := 0
LOCAL nColumns := 0
* LOCAL nnColumn := 0
LOCAL nuColumn
LOCAL ccValue
LOCAL i := 0
LOCAL j := 0
LOCAL oExcel as Object
LOCAL oWorkBook
LOCAL oHoja
LOCAL ccNameIs := ""
LOCAL NoSale := TRUE
LOCAL nnWiti := 0
LOCAL aTypes AS ARRAY
oExcel := TOleAuto():New( "Excel.Application" )
IF oExcel == nil
MsgStop('Excel no está instalado!','Error')
RETURN Nil
Endif
oWorkBook := oExcel:WorkBooks:Open( cArchivo )
oExcel:Sheets(1):Select()
oHoja := oExcel:ActiveSheet()
oExcel:Visible := .F. // <---- No Mostrar
oExcel:DisplayAlerts := .F. // <---- esta elimina mensajes
//
************** LOOP LECTURA PLANILLA EXCEL ******************
//
//------------ Averiguo Cantida de Filas ------------------
//
nFilas := oHoja:UsedRange:Rows:Count()
WinMain.Label_2.VALUE := TRANSFORM(nFilas, "999,999,999")
//
//------------ Averiguo Cantida de Columnas ------------------
//
nnColumn := 0
//
aNamis := {}
//
i := 0
nuColumn := 0
nColumns := Len( getProperty( "WinMain", "Grid_1", "Item", 1 ) )
DO WHILE nColumns != 0
WinMain.Grid_1.DeleteColumn( nColumns )
nColumns--
ENDDO
Do While NoSale
i := i + 1
ccValue := AnyToString( oHoja:cells(2,i):value )
nnWiti := GetLenColumn( LEN( ccValue ) )
ccNameIs := AnyToString( oHoja:cells(01, i):value )
IF EMPTY( ccNameIs ) .or. LEN( ccNameIs ) = 0 .or. ccNameIs = ' '
nuColumn := i - 1
NoSale := FALSE
ELSE
WinMain.Grid_1.AddColumn( i, ccNameIs, nnWiti, 0 )
Do Events
AADD(aNamis, ccNameIs )
AADD(aWitis, 120)
nnColumn := i
ENDIF
EndDo
//
IF nuColumn <> nnColumn
MsgInfo("nuColumn " + str(nuColumn) + " nnColumn " + str(nnColumn))
ENDIF
//
//------------------------------------------------------------
FOR i:=1 TO nnColumn Step 1
TipoDeDatos(oHoja:cells(2,i):value)
* Msgbox(STR(i))
NEXT i
WAIT WINDOW "Processing..." NOWAIT
//
aFila := {}
aTypes := {}
//
FOR i=2 TO nFilas Step 1
FOR j=1 TO nnColumn Step 1
ccValue := AnyToString( oHoja:cells(i,j):value )
AADD(aFila, ccValue )
AADD(aTypes, "C")
NEXT j
WinMain.Grid_1.addItem( ItemChar(aFila, aTypes) )
AADD(aHojita, aFila )
aFila := {}
aTypes := {}
Do Events
Next i
WAIT CLEAR
oExcel:DisplayAlerts := .F. // <---- esta elimina mensajes
oWorkBook:Close()
oExcel:Quit()
oWorkBook := NIL
oHoja := NIL
oExcel := NIL
WinMain.title := cArchivo
Release oWorkBook
Release oHoja
Release oExcel
RETURN Nil
*----------------------------------------------------------------------*
FUNCTION ItemChar(aLine, aType)
*----------------------------------------------------------------------*
LOCAL aRet:={}, x:=0, l:=0
aRet:=array( len(aLine) )
l:=len(aRet)
FOR x:=1 TO l
do case
case aType[x]=="N"
aRet[x]:=NTrim(aLine[x])
case aType[x]=="D"
aRet[x]:=dtoc(aLine[x])
case aType[x]=="L"
aRet[x]:=iif(aLine[x], "TRUE", "FALSE")
otherwise
aRet[x]:=aLine[x]
endcase
NEXT
RETURN aRet
FUNCTION AnyToString(csValue)
LOCAL ccValor := ""
LOCAL cdate
LOCAL cFormatoDaData := set(4)
SET DECIMALS TO 0
DO CASE
CASE Valtype(csValue) == "N"
ccValor := AllTrim(Str(csValue))
CASE Valtype(csValue) == "D"
IF !Empty(csValue)
cdate := dtos(csValue)
ccValor := substr(cDate,1,4) + "-" + substr(cDate,5,2) + "-" + substr(cDate,7,2)
ELSE
ccValor := ""
ENDIF
CASE Valtype(csValue) == "T"
IF !Empty(csValue)
cdate := dtos(csValue)
ccValor := substr(cDate,1,4) + "-" + substr(cDate,5,2) + "-" + substr(cDate,7,2)
ELSE
ccValor := ""
ENDIF
CASE Valtype(csValue) $ "CM"
IF Empty( csValue)
ccValor=""
ELSE
ccValor := "" + csValue+ ""
ENDIF
CASE Valtype(csValue) == "L"
ccValor := AllTrim(Str(iif(csValue == .F., 0, 1)))
OTHERWISE
ccValor := "" // NOTE: Here we lose csValues we cannot convert
ENDCASE
RETURN( ccValor )
FUNCTION GetLenColumn( nnLen )
LOCAL nnValor := 120
IF nnLen < 6
nnValor := 70
ELSEIF nnLen < 10
nnValor := 110
ELSEIF nnLen < 20
nnValor := 140
ELSEIF nnLen < 40
nnValor := 240
ELSE
nnValor := 380
ENDIF
RETURN( nnValor )
*-----------------------------------------------------------------------------------------------------------------------------------------------------------
PROCEDURE TipoDeDatos(csValue)
DO CASE
CASE Valtype(csValue) == "N"
AADD(aTypeCol,"N")
CASE Valtype(csValue) == "D"
AADD(aTypeCol,"D")
CASE Valtype(csValue) == "T"
AADD(aTypeCol,"D")
CASE Valtype(csValue) $ "CM"
AADD(aTypeCol,"C")
CASE Valtype(csValue) == "L"
AADD(aTypeCol,"L")
OTHERWISE
AADD(aTypeCol,"C")
ENDCASE
RETURN nil
*-----------------------------------------------------------------------------------------------------------------------------------------------------------
PROCEDURE GrabaDBF()
LOCAL cCampo := ''
LOCAL nAnchoMax := 0
LOCAL cColumna := ''
LOCAL cCreate := ''
PRIVATE aAnchosCampos := {}
PRIVATE aEncabezados := {}
cArchivo := ALLTRIM(WinMain.TextBox_1.VALUE)
FOR i=1 TO nnColumn Step 1
nAnchoMax := 0
FOR j=2 TO nFilas Step 1
IIF(nAnchoMax < LEN(WinMain.Grid_1.Cell(j,i)),nAnchoMax := LEN(WinMain.Grid_1.Cell(j,i)), )
NEXT j
Do Events
AADD(aAnchosCampos, nAnchoMax )
Next i
FOR i=1 TO nnColumn Step 1
cColumna:= WinMain.Grid_1.Header(i)
AADD(aEncabezados, cColumna)
Next i
cCreate := "{"
FOR i:=1 TO nnColumn Step 1
IF i == nnColumn
cCreate := cCreate + "{ '"+ aEncabezados[i] +"' , '"+ aTypeCol[i] +"', "+ ALLTRIM(STR(aAnchosCampos[i]))+",0}"
ELSE
cCreate := cCreate + "{ '"+ aEncabezados[i] +"' , '"+ aTypeCol[i] +"', "+ ALLTRIM(STR(aAnchosCampos[i]))+",0},"
ENDIF
NEXT i
cCreate := cCreate + "}"
IF !File(cArchivo)
MsgBox('No Existe el *.DBF')
DBCREATE(cArchivo, &(cCreate) )
USE &(cArchivo) ALIAS &(cArchivo) NEW
FOR i:=1 To nFilas Step 1
APPEND BLANK
FOR j:=1 TO nnColumn Step 1
cCampo := aEncabezados[j]
&(cArchivo)->&(cCampo) := WinMain.Grid_1.Cell(i,j)
NEXT j
NEXT i
Do Events
ELSE
USE &(cArchivo) ALIAS &(cArchivo) NEW
FOR i:=1 To nFilas Step 1
APPEND BLANK
FOR j:=1 TO nnColumn Step 1
cCampo := aEncabezados[j]
&(cArchivo)->&(cCampo) := WinMain.Grid_1.Cell(i,j)
NEXT j
NEXT i
Do Events
ENDIF
DBCLOSEALL()
RETURN NIL
*-----------------------------------------------------------------------------------------------------------------------------------------------------------
PROCEDURE FAR_OpenDBF()
LOCAL ccFile, nCampos, aCampos:={}
if EMPTY(ccFile) .or. ccFile==NIL .or. LEN(ccFile)=0 .or. !file(ccFile)
ccFile := getfile({{"Archivos excel (*.DBF)","*.dbf"}},"Seleccione un archivo DBF",GetCurrentFolder(),.f.)
endif
if EMPTY(ccFile) .or. ccFile==NIL .or. LEN(ccFile)=0 .or. !file(ccFile)
return nil
endif
cArchivo := SUBSTR(ccFile,RAT("\",ccFile)+1)
cArchivo := SUBSTR(cArchivo,1,RAT(".",cArchivo)-1)
WinMain.TextBox_1.VALUE := cArchivo
USE &(cArchivo) ALIAS &(cArchivo) NEW
aStruct := &(cArchivo)->(DBSTRUCT())
nTotalReg := &(cArchivo)->(LASTREC())
WinMain.Label_2.VALUE := TRANSFORM(nTotalReg , "999,999,999")
&(cArchivo)->(DBGOTOP())
Excel()
RETURN NIL
*-----------------------------------------------------------------------------------------------------------------------------------------------------------
STATIC PROCEDURE Excel()
LOCAL oExcel, oHoja, cCampo, i
oExcel := CreateObject( "Excel.Application" )
oExcel:WorkBooks:Add()
oHoja := oExcel:ActiveSheet()
oHoja:Cells:Font:Name := "Arial"
oHoja:Cells:Font:Size := 12
FOR n:=1 TO LEN(aStruct) STEP 1
cCampo := aStruct[n][1]
oHoja:Cells( 1,n ):Value := cCampo
NEXT n
&(cArchivo)->(DBGOTOP())
WAIT WINDOW "Processing..." NOWAIT
i:=2
DO WHILE !EOF()
FOR n:=1 TO LEN(aStruct) STEP 1
cCampo := aStruct[n][1]
oHoja:Cells( i,n ):Value := &(cArchivo)->&(cCampo)
NEXT n
&(cArchivo)->(DBSKIP())
i:=i+1
END DO
Do Events
WAIT CLEAR
FOR n:=1 TO LEN(aStruct) STEP 1
oHoja:Columns( n ):AutoFit()
NEXT n
oHoja:Cells( 1, 1 ):Select()
oExcel:Visible := .T.
RETURN
-
- Posts: 388
- Joined: Wed Nov 21, 2012 7:14 pm
- Location: México
Re: Como convierto un DBF a Excel
Witaj Mol ... Gdybym był w sklepie ....
Saludos
Polo
Saludos
Polo
Re: Como convierto un DBF a Excel
hola a todos:
gustavo, arturo:
me da mucho gusto que la rutina les haya sido de utilidad.
polo, se ve interesante el ejemplo que agregaste, voy a probarlo.
para subir un archivo, sigue estos pasos:
empaca el archivo que deseas subir.
elije el archivo (esta opcion viene abajo del cuerpo de donde escribimos)
agrega el archivo (otro poquito mas abajo)
envia el post y listo.
saludos a todos.
gustavo, arturo:
me da mucho gusto que la rutina les haya sido de utilidad.
polo, se ve interesante el ejemplo que agregaste, voy a probarlo.
para subir un archivo, sigue estos pasos:
empaca el archivo que deseas subir.
elije el archivo (esta opcion viene abajo del cuerpo de donde escribimos)
agrega el archivo (otro poquito mas abajo)
envia el post y listo.
saludos a todos.
Todo en el Nombre de Jesus / All in the name of Jesus
Carlos RD
Carlos RD
-
- Posts: 388
- Joined: Wed Nov 21, 2012 7:14 pm
- Location: México
Re: Como convierto un DBF a Excel
Si Carlos... pero no se por que pero no lo hace...
Saludos
Polo
Saludos
Polo
-
- Posts: 388
- Joined: Wed Nov 21, 2012 7:14 pm
- Location: México
-
- Posts: 388
- Joined: Wed Nov 21, 2012 7:14 pm
- Location: México
Re: Como convierto un DBF a Excel
No sube el archivo...
Otro dia será.
Otro dia será.
- danielmaximiliano
- Posts: 2612
- Joined: Fri Apr 09, 2010 4:53 pm
- Location: Argentina
- Contact:
Re: Como convierto un DBF a Excel
Leopoldo Blancas wrote:No sube el archivo...
Otro dia será.
Polo :
comprime los archivos, utiliza el boton examina, agrega el archivo mediante "Add the file", si quieres pegar en archivo en algun lugar del texto que estas escribiendo solo utiliza el boton "place inline"
*´¨)
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´. (¸.·` *
.·`. Harbour/HMG : It's magic !
(¸.·``··*
Saludos / Regards
DaNiElMaXiMiLiAnO
Whatsapp. := +54901169026142
Telegram Name := DaNiElMaXiMiLiAnO
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´. (¸.·` *
.·`. Harbour/HMG : It's magic !
(¸.·``··*
Saludos / Regards
DaNiElMaXiMiLiAnO
Whatsapp. := +54901169026142
Telegram Name := DaNiElMaXiMiLiAnO
-
- Posts: 388
- Joined: Wed Nov 21, 2012 7:14 pm
- Location: México
Re: Como convierto un DBF a Excel
Otra vez...
OK... creo que el error era que no lo comprimia...
Gracias Daniel...
OK... creo que el error era que no lo comprimia...
Gracias Daniel...
- esgici
- Posts: 4543
- Joined: Wed Jul 30, 2008 9:17 pm
- DBs Used: DBF
- Location: iskenderun / Turkiye
- Contact:
Re: Como convierto un DBF a Excel
sen de mi brütüs ?mol wrote:Dzięki chłopaki, wszystko zrozumiałem od ręki
Viva INTERNATIONAL HMG