Dbf To Excel(Excel Functions)

HMG Samples and Enhancements

Moderator: Rathinagiri

User avatar
SALINETAS24
Posts: 667
Joined: Tue Feb 27, 2018 3:06 am
DBs Used: DBF
Contact:

Re: Dbf To Excel(Excel Functions)

Post by SALINETAS24 »

Hola otra vez, ya lo he resuelto.., al final lo tengo que hacer a "manubrio", pero por si alguien ha sufrido el mismo problema aquí os paso la rutina.

Code: Select all

		aStr=LPEDIDOS->( DBSTRUCT() )
		ASIZE(aPos,LEN(aStr))
		
		FOR nPos=1 TO LEN(aStr)
			aPos[nPos]=""

			IF  aStr[nPos,2]="D"
				aPos[nPos]="C"  //--> Variable para saber que hay cambio
				aStr[nPos,2]="C" //--> modifico el tipo de dato, pasa de "D" a "C"
				aStr[nPos,3]=10  //-> modifico la anchura del campo
			ENDIF
			
		NEXT
		DBCREATE("FEXCEL", aStr,, .T., "MEMDATO")

		LPedidos -> (DbSeek(cClase))
		
		DO WHILE !LPEDIDOS ->(EOF()) .AND. LPEDIDOS->TIPO=cClase 
			IF LPEDIDOS->FECHA_PE >=aField[1]
		
				MEMDATO->(DBAPPEND())
				MEMDATO ->(lLockRec())
				
				LPEDIDOS->(SaveFields(aCampo))  //-> Esto es una rutina que carga los valores leidos en un array
			
				FOR nPos=1 TO len(aCampo)
				
					IF aPos[nPos]!="C"
						MEMDATO ->(FieldPut( nPos, aCampo[nPos]) )
					  ELSE
					    vVar=DtoC(aCampo[nPos])
						MEMDATO ->(FieldPut( nPos, vVar) )
					ENDIF
					
				NEXT
					
			ENDIF
			LPEDIDOS->(dBSkip())
		ENDDO

		
		COPY TO "FEXCEL.xls"
		MEMDATO->(DbCloseArea())
SALUD
Como dijo el gran pensador Hommer Simpson..., - En este mundo solo hay 3 tipos de personas, los que saben contar y los que no. :shock:
User avatar
mustafa
Posts: 1158
Joined: Fri Mar 20, 2009 11:38 am
DBs Used: DBF
Location: Alicante - Spain
Contact:

Re: Dbf To Excel(Excel Functions)

Post by mustafa »

Hola amigo SALINETAS24
He intentado también si conseguia que la fecha no saliera al reves
pero , no lo consigo

Tu fracción de rutina no consigo inprementarla en los dos samples
de este Pos --> DbfExcel.rar y Sample_Dbf_Excel_New.zip

Los samples no se refieren a un determinado fichero.dbf como en tu caso
que la rutina tiene que ser genérica para cualquier fichero.
y también está ocurriendo lo mismo con los ficheros nuevos generado PDF
que salen las fechas al reves.

Si puedes corregir alguno de estos samples o aportar tu alguno nuevo
que se puedan generar ficheros XLS y PDF

saludos

Y digo esto creo en ingles ?
*----------------------------------------------------------*
Hello friend SALINETAS24

I tried also if I did not get the date backwards
but, I do not get it

Your fraction of routine I can not impregnate it in the two samples
of this Pos -> DbfExcel.rar and Sample_Dbf_Excel_New.zip

The samples do not refer to a certain file.dbf as in your case
that the routine has to be generic for any file.
and the same is also happening with the new files generated PDF
that the dates go backwards.

If you can correct any of these samples or contribute your new ones
that XLS and PDF files can be generated

Regards
Mustafa
User avatar
SALINETAS24
Posts: 667
Joined: Tue Feb 27, 2018 3:06 am
DBs Used: DBF
Contact:

Re: Dbf To Excel(Excel Functions)

Post by SALINETAS24 »

ok, preparo una subrutina generica y la cuelgo
Como dijo el gran pensador Hommer Simpson..., - En este mundo solo hay 3 tipos de personas, los que saben contar y los que no. :shock:
User avatar
SALINETAS24
Posts: 667
Joined: Tue Feb 27, 2018 3:06 am
DBs Used: DBF
Contact:

Re: Dbf To Excel(Excel Functions)

Post by SALINETAS24 »

Vaya tela no se como demonios subirlo..., en fin.., "a pedal".
Amigo Mustafa, aquí tienes el programa ajustado, para que lo pruebes y mejores ... seguro.
Ya hemos salvado el tema de las fechas.
Un abrazo.
En Ingles dice Dr. Goolgle que he escrito esto.

Go cloth do not know how to climb it ..., well ..., "pedal".
Friend Mustafa, here is the adjusted program, so you can try it and better ... for sure.
We have already saved the subject of dates.
A hug.

Code: Select all

//-----------------------------------------------------------------------------------------
//-----------------------------------------------------------------------------------------
//--> ORIGINAL de MUSTAFA
//--> CONTRIBUCION by SARGANTANA SOFT - José Manuel Carbonell
//--> MODULO : DBF to EXCEL 
//--> 26/04/2018 - V1.1 -> Revisión y ajustes, por fin tenemos fechas. jejejee
//-----------------------------------------------------------------------------------------
//-----------------------------------------------------------------------------------------


#include <hmg.ch>

Function Main

  PUBLIC cFileName , cFileD  , Nuevo , oExcel
  PUBLIC ficheraax , ficheraaxA , nPos

  DEFINE WINDOW main ;
         AT 350 , 605 ;
         WIDTH 452 HEIGHT 306 ;
         TITLE "" ;
         NOMAXIMIZE MAIN

    DEFINE BUTTON Button_1
        ROW    040
        COL    020
        WIDTH  100
        HEIGHT 028
        ACTION GetDbfFileName()
        CAPTION "Select Dbf"
        FONTNAME "Arial"
        FONTSIZE 9
        TOOLTIP ""
        FONTBOLD .F.
        FONTITALIC .F.
        FONTUNDERLINE .F.
        FONTSTRIKEOUT .F.
        ONGOTFOCUS Nil
        ONLOSTFOCUS Nil
        HELPID Nil
        FLAT .F.
        TABSTOP .T.
        VISIBLE .T.
        TRANSPARENT .F.
        MULTILINE .F.
        PICTURE Nil
        PICTALIGNMENT TOP
    END BUTTON

    DEFINE LABEL Label_1
        ROW    047
        COL    156 
        WIDTH  250
        HEIGHT 028
        VALUE ""
        FONTNAME "Arial"
        FONTSIZE 9
        TOOLTIP ""
        FONTBOLD .F.
        FONTITALIC .F.
        FONTUNDERLINE .F.
        FONTSTRIKEOUT .F.
        HELPID Nil
        VISIBLE .T.
        TRANSPARENT .F.
        ACTION Nil
        AUTOSIZE .F.
        BACKCOLOR NIL
        FONTCOLOR NIL
    END LABEL

    DEFINE BUTTON Button_2
        ROW    120
        COL    020
        WIDTH  100
        HEIGHT 028
        ACTION  Export_Xls()     
        CAPTION "Export File"
        FONTNAME "Arial"
        FONTSIZE 9
        TOOLTIP ""
        FONTBOLD .F.
        FONTITALIC .F.
        FONTUNDERLINE .F.
        FONTSTRIKEOUT .F.
        ONGOTFOCUS Nil
        ONLOSTFOCUS Nil
        HELPID Nil
        FLAT .F.
        TABSTOP .T.
        VISIBLE .T.
        TRANSPARENT .F.
        MULTILINE .F.
        PICTURE Nil
        PICTALIGNMENT TOP
    END BUTTON

    DEFINE TEXTBOX Text_1
        ROW    082
        COL    150
        WIDTH  250
        HEIGHT 024
        FONTNAME "Arial"
        FONTSIZE 9
        TOOLTIP ""
        ONCHANGE Nil
        ONGOTFOCUS Nil
        ONLOSTFOCUS Nil
        FONTBOLD .F.
        FONTITALIC .F.
        FONTUNDERLINE .F.
        FONTSTRIKEOUT .F.
        ONENTER Nil
        HELPID Nil
        TABSTOP .T.
        VISIBLE .T.
        READONLY .T.
        RIGHTALIGN .F.
        DISABLEDBACKCOLOR Nil
        DISABLEDFONTCOLOR Nil
        CASECONVERT NONE
        BACKCOLOR Nil
        FONTCOLOR Nil
        INPUTMASK Nil
        FORMAT Nil
        VALUE ""
    END TEXTBOX

    DEFINE LABEL Label_2
        ROW    083
        COL    020
        WIDTH  120
        HEIGHT 028
        VALUE "Excel FileName"
        FONTNAME "Arial"
        FONTSIZE 9
        TOOLTIP ""
        FONTBOLD .F.
        FONTITALIC .F.
        FONTUNDERLINE .F.
        FONTSTRIKEOUT .F.
        HELPID Nil
        VISIBLE .T.
        TRANSPARENT .F.
        ACTION Nil
        AUTOSIZE .F.
        BACKCOLOR Nil
        FONTCOLOR Nil
    END LABEL
 
     DEFINE LABEL Label_3
        ROW    140
        COL    159  
        WIDTH  250
        HEIGHT 028
        VALUE ""
        FONTNAME "Arial"
        FONTSIZE 9
        TOOLTIP ""
        FONTBOLD .F.
        FONTITALIC .F.
        FONTUNDERLINE .F.
        FONTSTRIKEOUT .F.
        HELPID Nil
        VISIBLE .T.
        TRANSPARENT .F.
        ACTION Nil
        AUTOSIZE .F.
        BACKCOLOR NIL
        FONTCOLOR NIL
    END LABEL

    DEFINE  CHECKBOX Check_1
        ROW    166
        COL    159 
        WIDTH  150  
        CAPTION SPACE(3)+'Excel Pdf ?'       
        VALUE  .T.
        FONTNAME "Arial"
        FONTSIZE 9
        FONTBOLD .T.  
        ONCHANGE CambiaXq()
    END CHECKBOX

    DEFINE BUTTON Button_3
        ROW    180
        COL    020
        WIDTH  100
        HEIGHT 028
        ACTION Main.Release
        CAPTION "Exit"
        FONTNAME "Arial"
        FONTSIZE 9
        TOOLTIP ""
        FONTBOLD .F.
        FONTITALIC .F.
        FONTUNDERLINE .F.
        FONTSTRIKEOUT .F.
        ONGOTFOCUS Nil
        ONLOSTFOCUS Nil
        HELPID Nil
        FLAT .F.
        TABSTOP .T.
        VISIBLE .T.
        TRANSPARENT .F.
        MULTILINE .F.
        PICTURE Nil
        PICTALIGNMENT TOP
    END BUTTON

 END WINDOW

    Main.Label_3.Value := "Yes File Excel.Pdf" 

 Main.Center
 Main.Activate

Return

*------------------------------------------------------------------------*
FUNCTION GetDbfFileName()
*------------------------------------------------------------------------*
  
  Public cFileName := ''
  
  cFileName := UPPER(Getfile ( { {'Dbf Files','*.dbf'} } , 'Select File' , , .f. , .f., 1))

 If len(cFileName) > 4
  Main.Text_1.Value := Substr(cFilename,1,len(cFilename)-4)
 EndIf 
 
 IF cFileName < SPACE(1)
      msgStop('Missing File','Attention !!!')
      return nil
 ENDIF

   *---------------  File + ".dbf" =  Calculo Digitos ------------------*

  cFileD := cFileName

  ficheraax := LEFT( cFileD , LEN(cFileD) ) 

  nPos := RAT("\", cFileD) 

  ficheraaxA  = SUBSTR(cFileD, 1, nPos) 

*----------------------------------------------------------------------*

  cFileD := cFileName

  ficheraax := RIGHT( cFileD , LEN(cFileD) - RAT("\", cFileD ))  

*---------------  Solo File  =  Calculo Digitos ----------------------*

   Nuevo =  LEFT ( ficheraax , LEN( ficheraax ) - 4 ) 
     
   Main.Label_1.Value := alltrim(Nuevo + ".dbf")

 RETURN NIL

*------------------------------------------------------------------------*
Function DbfToExcel(cExcelName) // We need full path for both files
*------------------------------------------------------------------------*
private oExcel := nil
private oActive := nil
private nFields := 0
private cRange := ''
private aStructure := {}

nRecNo := LastRec()
aStructure := DBStruct()
nFields := len(aStructure)

oExcel:= TOleAuto():New( "Excel.Application" )

oExcel:WorkBooks:Open(cExcelName+".dbf")    //  cDbfFile)
oActive := oExcel:ActiveSheet()
oExcel:DisplayAlerts := .F.               // Doesn't display Excel alerts  

oActive:PageSetup:Zoom := .F.                     //Fit all columns in one page, and page orientation to landscape
oActive:PageSetup:Orientation := 2 
oActive:PageSetup:FitToPagesTall := .F.
oActive:PageSetup:FitToPagesWide := 1                       
oExcel:Visible := .F.                             // Do not show the excel file on screen 

oExcel:ActiveWorkbook:ExportAsFixedFormat(0,cExcelName + ".PDF")  //Export the excel file as PDF
oExcel:Application:Quit()

RELEASE oActive
RELEASE oExcel

Msginfo("Finished!!!","Done!")

return

*--------------------------------------------*
FUNCTION Export_Xls()
*--------------------------------------------*
Local cAlias, cClase, vVar
Local aStr:={}
Local aPos:={}
Local aCampo:={}
Local nPos:=0
Local cDir:=""
	
CambiaXq()
 
	CLOSE DATABASES
	USE &Nuevo  ALIAS LPEDIDOS
	
  	aStr=LPEDIDOS->( DBSTRUCT() )

		ASIZE(aPos,LEN(aStr))
		
		FOR nPos=1 TO LEN(aStr)

			aPos[nPos]=""

			IF  aStr[nPos,2]="D"
				aPos[nPos]="C"
				aStr[nPos,2]="C"
				aStr[nPos,3]=10
			ENDIF
			
		NEXT
		
		DBCREATE("FEXCEL", aStr,, .T., "MEMDATO")

		LPedidos -> (DbGotop())
		
		DO WHILE !LPEDIDOS ->(EOF()) 
		
				MEMDATO->(DBAPPEND())
				MEMDATO ->(DbrLock())
				
				LPEDIDOS->(SaveFields(aCampo))
			
				FOR nPos=1 TO len(aCampo)
				
					IF aPos[nPos]!="C"
						MEMDATO ->(FieldPut( nPos, aCampo[nPos]) )
					  ELSE
					    vVar=DtoC(aCampo[nPos])
						MEMDATO ->(FieldPut( nPos, vVar) )
					ENDIF
					
				NEXT
				MEMDATO ->(DbUnLock())
					
				LPEDIDOS->(dBSkip())
		ENDDO
		
		// --> LO GRABO EN EL RAIZ, QUE SI NO SE ME PIERDE...
		// --> TU LO PONES DONDE QUIERES.., AH Y SEGURO QUE LO MEJORAS
		
		COPY TO "C:\FEXCEL.xls"
		MEMDATO->(DbCloseArea())
		CLOSE DATABASES






IF aChecboQ = "True"   
  Main.Label_3.Value := " "
  Main.Label_3.Value := alltrim(Nuevo + ".Pdf")
  DbfToExcel(alltrim(Main.Text_1.Value)) 
ENDIF

Msginfo("Finished!!!","Done!")





return

*------------------------*
  FUNCTION   CambiaXq()
*------------------------*

  PUBLIC aChecboQ

   aChecboQ  := ( IIF(Main.Check_1.Value,"True","False") )
 
   IF aChecboQ = "True"   

     Main.Label_3.Value := "Yes File Excel.Pdf"

   ELSE

     Main.Label_3.Value := "No File Excel.Pdf"
  
      
  ENDIF

RETURN NIL

// ----------------------------------------------------------------------------
// ----------------------------------------------------------------------------
// --> FUNCION DE LAS SPTOOLS
// --> MODIFICACION REALIZADA POR JOSE M. CARBONELL
// --> PROYECTO SARGANTANA SOFT
// ----------------------------------------------------------------------------
// Categoria: FUNCIONES BASE DE DATOS
// ----------------------------------------------------------------------------
// Pasa los FIELDS de una base de datos a un Array
// Sintax
// SaveFields( <aData>, nIni ) --> nil
// Parametros
// <aData> es el array que queremos cargar.
// <nIni>  Valor númerico.  0 carga, 1 inicializa
//         Por defecto, el valor será cero

proc SaveFields( aData, nIni )

   local n
   local nLen := FCount()
   local aFtip[nLen]
   local aFlon[nLen]
   Default nIni := 0

   AFields("",aFtip,aFlon,"")
   ASize( aData, 0 )

   for n = 1 to nLen
      AAdd( aData, FieldGet( n ) )
      IF nIni=1
         DO Case
            Case aFtip[n]="N"
                 STORE 0 TO aData[n]
            Case aFtip[n]="C"
				  aData[n]:=""			  
*                 STORE SPACE(aFlon[n]) to aData[n]
*                 MsgStop(str(aFlon[n]))
            Case aFtip[n]="D"
                 aData[n]=DATE()
            Case aFtip[n]="L"
                 aData[n]=.f.
            OTHERWISE
                 aData[n]=""
*				 STORE SPACE(aFlon[n]) to aData[n]
         ENDCASE
      ENDIF
   next

return



Como dijo el gran pensador Hommer Simpson..., - En este mundo solo hay 3 tipos de personas, los que saben contar y los que no. :shock:
User avatar
mustafa
Posts: 1158
Joined: Fri Mar 20, 2009 11:38 am
DBs Used: DBF
Location: Alicante - Spain
Contact:

Re: Dbf To Excel(Excel Functions)

Post by mustafa »

Hola amigos:
En especial José Manuel Carbonell ("SALINETAS24")
Creo que se ha mejorado mucho el antiguo programa iniciado
por Nikos y Vagblad con el tema de fechas

Con la contibución de SALINETAS24 se ha conseguido que ya
se puedan leer la fechas normalmente.

Mediante algunos trucos nada ortodoxos en la programación
Renombrando y Copiando Ficheros , aqui y alla ...
He conseguido que el fichero PDF generado tambien se leea la
Fecha normal.
Queda pendiente los acentos grámaticales y tambien No asume
el campo Memo , de los ficheros DBT.
Bueno aqui está mi pequeña contribución
Un Saludo
Mustafa
Y el Dr. Googles dice ...............

*------------------------------------------------------------------------------*

Hello friends:
Especially José Manuel Carbonell ("SALINETAS24")
I think the old program that has been started has been greatly improved
by Nikos and Vagblad with the theme of dates

With the contribution of SALINETAS24 it has been achieved that
you can read the dates normally.

By some unorthodox tricks in programming
Renaming and Copying Files, here and there ...
I managed to get the generated PDF file also read the
Normal date
Grammatical accents are pending and it also does not assume
the Memo field, of the DBT files.
Well here is my small contribution

Greeting
Mustafa
Attachments
Converter_Dbf_Excel_Pdf_2018.zip
(73.49 KiB) Downloaded 357 times
User avatar
SALINETAS24
Posts: 667
Joined: Tue Feb 27, 2018 3:06 am
DBs Used: DBF
Contact:

Re: Dbf To Excel(Excel Functions)

Post by SALINETAS24 »

Hola Mustafa te ha quedado genial.
Oye.., a mi los acentos me funcionan de maravilla.
Un abrazo amigo,
Como dijo el gran pensador Hommer Simpson..., - En este mundo solo hay 3 tipos de personas, los que saben contar y los que no. :shock:
User avatar
mustafa
Posts: 1158
Joined: Fri Mar 20, 2009 11:38 am
DBs Used: DBF
Location: Alicante - Spain
Contact:

Re: Dbf To Excel(Excel Functions)

Post by mustafa »

Hola amigo José Manuel
Como comenté aqui está la muestra

Fichero Original visto con DBA
Los acentos están correctos

Con la conversión
Desde Hoja Excel y desde PDF
No es correcto los acentos

Saludos
Mustafa
*-------------------------------------------------*
Hello Friend José Manuel
As I mentioned here is the sample

Original file seen with DBA
The accents are correct

With the conversion
From Excel Sheet and from PDF
The accents are not correct

Regards
Mustafa
Attachments
Error.jpg
Error.jpg (153.33 KiB) Viewed 4476 times
User avatar
SALINETAS24
Posts: 667
Joined: Tue Feb 27, 2018 3:06 am
DBs Used: DBF
Contact:

Re: Dbf To Excel(Excel Functions)

Post by SALINETAS24 »

Pues tienes razón.., y una vez analizado el problema te paso la solución.
Disculpa, pero antes no lo había detectado.
Lo que hago es cargar el código de página con la que trabajan EXCEL y PDF "REQUEST HB_CODEPAGE_ES850"
Y después antes de grabar la línea, y siempre y cuando sean caracteres le doy el cambiazo
aCampo[nPos]= HB_TRANSLATE( cCadena, , "ES850" )
Y lo demás lo hace automático :lol:
Un abrazo y esto hay que celebrarlo con una "serveseta"

Y en ingles dice Dr. Google que he dicho...


Well, you're right ... and once I've analyzed the problem, I'll give you the solution.
Sorry, but I had not detected it before.
What I do is load the page code with which EXCEL and PDF work "REQUEST HB_CODEPAGE_ES850"
And then before recording the line, and as long as they are characters I give him the change
aCampo [nPos] = HB_TRANSLATE (cString,, "ES850")
And the rest makes it automatic: lol:
A hug and this must be celebrated with a "serveseta"

Code: Select all

//-----------------------------------------------------------------------------------------
//-----------------------------------------------------------------------------------------
//--> ORIGINAL by Nikos and Vagblad  -->  "DbfExcel.rar"
//--> CONTRIBUCION by Mustafa López
//--> CONTRIBUCION by SARGANTANA SOFT - José Manuel Carbonell
//--> MODULO : DBF to EXCEL 
//--> 26/04/2018 - V1.1 -> Revisión y ajustes, por fin tenemos fechas. jejejee
//-----------------------------------------------------------------------------------------
//-----------------------------------------------------------------------------------------

#include <hmg.ch>

Function Main
 
  REQUEST DBFCDX , DBFFPT , DBFDBT
  RDDSETDEFAULT( "DBFCDX" )
  
 *----------------------------------* 

  REQUEST HB_CODEPAGE_ES850
*----------------------------------*
  SET CENTURY ON
  SET DATE FRENCH
  SET ESCAPE ON

 SET LANGUAGE TO SPANISH 
 SET CODEPAGE TO UNICODE

  SET DELETED ON
  SET DATE FORMAT TO 'dd/mm/yyyy'
  SET BROWSESYNC ON
  SET INTERACTIVECLOSE OFF  
  SET TOOLTIPSTYLE BALLOON  
*----------------------------------* 

  PUBLIC cFileName , cFileD  , Nuevo , oExcel 
  PUBLIC ficheraax , ficheraaxA , nPos , cExcelName 
  PUBLIC cDir ,  xange1 , nom_1 , nom_2

  DEFINE WINDOW main          ;
         AT 350 , 605         ;
         WIDTH 425 HEIGHT 295 ; 
         TITLE "Converter DBF -> Exel ->PDF  v 1.1  2018" ;
         ICON 'Logo'          ;   
         NOMAXIMIZE NOSIZE MAIN 
      
         ON KEY ESCAPE ACTION  EraserTemp()  
 
    DEFINE BUTTON Button_1
        ROW    040
        COL    020
        WIDTH  110
        HEIGHT 028
        ACTION GetDbfFileName()
        CAPTION space(5)-"Select Dbf"
        FONTNAME "Arial"
        FONTSIZE 9
        TOOLTIP ""
        FONTBOLD .F.
        FONTITALIC .F.
        FONTUNDERLINE .F.
        FONTSTRIKEOUT .F.
        ONGOTFOCUS Nil
        ONLOSTFOCUS Nil
        HELPID Nil
        FLAT .F.
        TABSTOP .T.
        VISIBLE .T.
        TRANSPARENT .F.
        MULTILINE .F.
        PICTURE  "Resource\Folder.bmp"
        PICTALIGNMENT LEFT               // TOP
    END BUTTON

    DEFINE LABEL Label_1
        ROW    047
        COL    156 
        WIDTH  250
        HEIGHT 028
        VALUE ""
        FONTNAME "Arial"
        FONTSIZE 9
        TOOLTIP ""
        FONTBOLD .F.
        FONTITALIC .F.
        FONTUNDERLINE .F.
        FONTSTRIKEOUT .F.
        HELPID Nil
        VISIBLE .T.
        TRANSPARENT .F.
        ACTION Nil
        AUTOSIZE .F.
        BACKCOLOR NIL
        FONTCOLOR NIL
    END LABEL

    DEFINE BUTTON Button_2
        ROW    120
        COL    020
        WIDTH  110
        HEIGHT 028
        ACTION Export_Xls() 
        CAPTION space(5)-"Export File"
        FONTNAME "Arial"
        FONTSIZE 9
        TOOLTIP ""
        FONTBOLD .F.
        FONTITALIC .F.
        FONTUNDERLINE .F.
        FONTSTRIKEOUT .F.
        ONGOTFOCUS Nil
        ONLOSTFOCUS Nil
        HELPID Nil
        FLAT .F.
        TABSTOP .T.
        VISIBLE .T.
        TRANSPARENT .F.
        MULTILINE .F.
        PICTURE  "Resource\Exel.bmp"
        PICTALIGNMENT LEFT            // TOP
    END BUTTON

    DEFINE TEXTBOX Text_1
        ROW    082
        COL    150
        WIDTH  250
        HEIGHT 024
        FONTNAME "Arial"
        FONTSIZE 9
        TOOLTIP ""
        ONCHANGE Nil
        ONGOTFOCUS Nil
        ONLOSTFOCUS Nil
        FONTBOLD .F.
        FONTITALIC .F.
        FONTUNDERLINE .F.
        FONTSTRIKEOUT .F.
        ONENTER Nil
        HELPID Nil
        TABSTOP .T.
        VISIBLE .T.
        READONLY .T.
        RIGHTALIGN .F.
        DISABLEDBACKCOLOR { 251,221,251 }  
        DISABLEDFONTCOLOR Nil
        CASECONVERT NONE
        BACKCOLOR Nil
        FONTCOLOR Nil
        INPUTMASK Nil
        FORMAT Nil
        VALUE ""
    END TEXTBOX

    DEFINE LABEL Label_2
        ROW    085
        COL    020
        WIDTH  120
        HEIGHT 028
        VALUE "Excel FileName"
        FONTNAME "Arial"
        FONTSIZE 9
        TOOLTIP ""
        FONTBOLD .F.
        FONTITALIC .F.
        FONTUNDERLINE .F.
        FONTSTRIKEOUT .F.
        HELPID Nil
        VISIBLE .T.
        TRANSPARENT .F.
        ACTION Nil
        AUTOSIZE .F.
        BACKCOLOR Nil
        FONTCOLOR Nil
    END LABEL
 
     DEFINE LABEL Label_3
        ROW    140
        COL    159  
        WIDTH  250
        HEIGHT 028
        VALUE ""
        FONTNAME "Arial"
        FONTSIZE 9
        TOOLTIP ""
        FONTBOLD .F.
        FONTITALIC .F.
        FONTUNDERLINE .F.
        FONTSTRIKEOUT .F.
        HELPID Nil
        VISIBLE .T.
        TRANSPARENT .F.
        ACTION Nil
        AUTOSIZE .F.
        BACKCOLOR NIL
        FONTCOLOR NIL
    END LABEL

    DEFINE  CHECKBOX Check_1
        ROW    166
        COL    159 
        WIDTH  150  
        CAPTION SPACE(3)+'Excel Pdf ?'       
        VALUE  .T.
        FONTNAME "Arial"
        FONTSIZE 9
        FONTBOLD .T.  
        ONCHANGE CambiaXq()
    END CHECKBOX

    DEFINE BUTTON Button_3
        ROW    180
        COL    020
        WIDTH  110
        HEIGHT 028
        ACTION EraserTemp()  
        CAPTION space(10)-"Exit"
        FONTNAME "Arial"
        FONTSIZE 9
        TOOLTIP ""
        FONTBOLD .F.
        FONTITALIC .F.
        FONTUNDERLINE .F.
        FONTSTRIKEOUT .F.
        ONGOTFOCUS Nil
        ONLOSTFOCUS Nil
        HELPID Nil
        FLAT .F.
        TABSTOP .T.
        VISIBLE .T.
        TRANSPARENT .F.
        MULTILINE .F.
        PICTURE "Resource\Cancel.bmp"
        PICTALIGNMENT LEFT            // TOP
    END BUTTON

 
 END WINDOW

    SETWINDOWCURSOR ( Main.Button_3.Handle , "Resource\finger.cur")

    Main.Label_3.Value := "Yes File Excel.Pdf" 

 Main.Center
 Main.Activate

Return

*------------------------------------------------------------------------*
 FUNCTION GetDbfFileName()
*------------------------------------------------------------------------*
  
  Public cFileName := ''
  
  cFileName := UPPER(Getfile ( { {'Dbf Files','*.dbf'} } , 'Select File' , , .f. , .f., 1))

  IF LEN(cFileName) > 4
       Main.Text_1.Value := Substr(cFilename,1,len(cFilename)-4)
  ENDIF 
 
  IF cFileName < SPACE(1)
      MsgStop('Missing File','Attention !!!')
      Return Nil
  ENDIF

 *------------------  File + ".dbf" =  Calculo Digitos ------------------*

  cFileD := cFileName

  ficheraax := LEFT( cFileD , LEN(cFileD) ) 

  nPos := RAT("\", cFileD) 

  ficheraaxA  = SUBSTR(cFileD, 1, nPos) 

*------------------------------------------------------------------------*

  cFileD := cFileName

  ficheraax := RIGHT( cFileD , LEN(cFileD) - RAT("\", cFileD ))  

*------------------  Solo File  =  Calculo Digitos ----------------------*

   Nuevo =  LEFT ( ficheraax , LEN( ficheraax ) - 4 ) 
     
   Main.Label_1.Value := alltrim(LOWER(Nuevo + ".Dbf"))

 RETURN NIL

*------------------------------------------------------------------------*
 FUNCTION DbfToExcel(cExcelName) // We need full path for both files
*------------------------------------------------------------------------*
private oExcel := nil
private oActive := nil
private nFields := 0
private cRange := ''
private aStructure := {}
close databases
nRecNo := LastRec()
aStructure := DBStruct()
nFields := len(aStructure)

oExcel:= TOleAuto():New( "Excel.Application" )

oExcel:WorkBooks:Open( LOWER(cExcelName )+".dbf")        
oActive := oExcel:ActiveSheet()
oExcel:DisplayAlerts := .F.                      // Doesn't display Excel alerts  

oActive:PageSetup:Zoom := .F.                     //Fit all columns in one page, and page orientation to landscape
oActive:PageSetup:Orientation := 2 
oActive:PageSetup:FitToPagesTall := .F.
oActive:PageSetup:FitToPagesWide := 1                       
oExcel:Visible := .F.                             // Do not show the excel file on screen 
oExcel:ActiveWorkbook:ExportAsFixedFormat(0, LOWER(cExcelName) + ".pdf")  //Export the excel file as PDF
oExcel:Application:Quit()

RELEASE oActive
RELEASE oExcel

Return

*------------------------------------------------------------------------*
FUNCTION Export_Xls()
*------------------------------------------------------------------------*
Local cAlias, cClase, vVar, cCadena
Local aStr:={}
Local aPos:={}
Local aCampo:={}
Local nPos:=0
Local cDir:=""

Main.Check_1.Enabled  := .F.
Main.Button_1.Enabled := .F.
Main.Button_2.Enabled := .F.
Main.Button_3.Enabled := .F.

  CambiaXq()
 
	CLOSE DATABASES
	USE &Nuevo  ALIAS LPEDIDOS

  	aStr=LPEDIDOS->( DBSTRUCT() )

		ASIZE(aPos,LEN(aStr))
		
		FOR nPos=1 TO LEN(aStr)

			aPos[nPos]=""

			IF  aStr[nPos,2]="D"
				aPos[nPos]="C"
				aStr[nPos,2]="C"
				aStr[nPos,3]=10
			ENDIF
			
		NEXT
		
		DBCREATE( "NuevoE", aStr,, .T., "MEMDATO")

		LPedidos -> (DbGotop())
		
		DO WHILE !LPEDIDOS ->(EOF()) 
		
				MEMDATO->(DBAPPEND())
				MEMDATO ->(DbrLock())
				
				LPEDIDOS->(SaveFields(aCampo))
			
				FOR nPos=1 TO len(aCampo)
				
*					cCadena=(aCampo[nPos])
*					msgbox(cCadena)
					
					if !empty(cCadena) .and. VALTYPE(cCadena)="C"
						aCampo[nPos]= HB_TRANSLATE( cCadena, , "ES850" ) 
					ENDIF
					
*					msgbox(aCampo[nPos])
					
					IF aPos[nPos]!="C"
						MEMDATO ->(FieldPut( nPos, aCampo[nPos]) )
					  ELSE
					    vVar=DtoC(aCampo[nPos])
						MEMDATO ->(FieldPut( nPos, vVar) )
					ENDIF
					
				NEXT
				MEMDATO ->(DbUnLock())
					
				LPEDIDOS->(dBSkip())
		ENDDO
	
		// --> LO GRABO EN EL RAIZ, QUE SI NO SE ME PIERDE...
		// --> TU LO PONES DONDE QUIERES.., AH Y SEGURO QUE LO MEJORAS
		
		MSGBOX(LOWER(NUEVO))

		COPY TO &(LOWER(Nuevo)+".xls")      
                COPY FILE &(LOWER(Nuevo)+".xls") TO  &(LOWER(Nuevo)+"1.dbf")  
		MEMDATO->(DbCloseArea())
		CLOSE DATABASES



IF aChecboQ = "True"   
*------------------------------------------------------------------------*
  Main.Label_3.Value := " "
  Main.Label_3.Value := alltrim(LOWER(Nuevo + ".Pdf"))
*------------------------------------------------------------------------*
  cDir  := GetCurrentFolder()  
  xange1 := ( cDir  +"\"+ LOWER(Nuevo)+"1")  
  DbfToExcel( ALLTRIM( xange1 ) )   
*------------------------------------------------------------------------*
  nom_1 := LOWER(Nuevo)+"1.pdf" 
  nom_2 := LOWER(Nuevo)+".pdf" 
  FRENAME( nom_1 , nom_2 )           // Rename Definitive File
*------------------------------------------------------------------------*
ENDIF

  Msginfo("Finished!!!","Done!")

  CLOSE DATABASES
  FileDelete("NuevoE.*")              // Delete Temporary File
  FileDelete( (Nuevo)+"1.dbf" )       // Delete Temporary File

  Main.Check_1.Enabled  := .T.
  Main.Button_1.Enabled := .T.
  Main.Button_2.Enabled := .T.
  Main.Button_3.Enabled := .T.

Return Nil

*------------------------------------------------------------------------*
  FUNCTION   CambiaXq()
*------------------------------------------------------------------------*
  PUBLIC aChecboQ

   aChecboQ  := ( IIF(Main.Check_1.Value,"True","False") )
 
   IF aChecboQ = "True"   
      Main.Label_3.Value := "Yes File Excel.Pdf"
   ELSE
     Main.Label_3.Value := "No File Excel.Pdf"
   ENDIF

RETURN NIL

*------------------------------------------------------------------------*
FUNCTION EraserTemp()
*------------------------------------------------------------------------*
IF FILE("NuevoE.*")
   FileDelete("NuevoE.*")
   FileDelete( (Nuevo)+"1.dbf" )
   Main.Release
ELSE 
   Main.Release
ENDIF

RETURN NIL

*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

// ----------------------------------------------------------------------------
// ----------------------------------------------------------------------------
// --> FUNCION DE LAS SPTOOLS
// --> MODIFICACION REALIZADA POR JOSE M. CARBONELL
// --> PROYECTO SARGANTANA SOFT
// ----------------------------------------------------------------------------
// Categoria: FUNCIONES BASE DE DATOS
// ----------------------------------------------------------------------------
// Pasa los FIELDS de una base de datos a un Array
// Sintax
// SaveFields( <aData>, nIni ) --> nil
// Parametros
// <aData> es el array que queremos cargar.
// <nIni>  Valor númerico.  0 carga, 1 inicializa
//         Por defecto, el valor será cero

*------------------------------------------------------------------------*
Proc SaveFields( aData, nIni )
*------------------------------------------------------------------------*

   local n
   local nLen := FCount()
   local aFtip[nLen]
   local aFlon[nLen]
   Default nIni := 0

   AFields("",aFtip,aFlon,"")
   ASize( aData, 0 )

   for n = 1 to nLen
      AAdd( aData, FieldGet( n ) )
      IF nIni=1
         DO Case
            Case aFtip[n]="N"
                 STORE 0 TO aData[n]
            Case aFtip[n]="C"
		 aData[n]:=""			  
*                STORE SPACE(aFlon[n]) to aData[n]
*                MsgStop(str(aFlon[n]))
            Case aFtip[n]="D"
                 aData[n]=DATE()
            Case aFtip[n]="L"
                 aData[n]=.f.
            OTHERWISE
                 aData[n]=""
*		 STORE SPACE(aFlon[n]) to aData[n]
         ENDCASE
      ENDIF
   next

Return

*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
Como dijo el gran pensador Hommer Simpson..., - En este mundo solo hay 3 tipos de personas, los que saben contar y los que no. :shock:
User avatar
mustafa
Posts: 1158
Joined: Fri Mar 20, 2009 11:38 am
DBs Used: DBF
Location: Alicante - Spain
Contact:

Re: Dbf To Excel(Excel Functions)

Post by mustafa »

Hola amigos:
Tras varios experimentos , tengo que reconocer que no se
lo que puede pasar con el tema de acentos, las "ñ" etc.
En el último intento he obseravdo que antes de la conversión
el fichero "clientes.dbf" he invertido los simbolos -> ver muestra
y curiosamente el resultado ha sido satisfactorio con los nuevos
ficheros Generados xls y pdf.
Negativamente ha sido el fichero grabado normal "control.dbf"
que las conversiones salen mal, los acentos y las "ñ" el tema fechas
satisfactoriamente sale bien , con las correcciones efectuadas por
José Manuel "SALINETAS24".
Si algún compañero puede estudiar este tema sería interesante, no se si
ocurre lo mismo en otros idiomas que tengan también signos especiales ?
El código fuente Prg , he experimentado salvandolo tanto en ANSI como
en UTF-8 si dar ningun núevo resultado. Ver ---> "Error.zip"
Saludos
Mustafa
*--------------------------------- Google ---------------------------------*
Hello friends:
After several experiments, I have to admit that I do not know
what can happen with the theme of accents, the "ñ" etc.
In the last attempt I observed that before the conversion
the file "clientes.dbf" I have inverted the symbols -> see sample
and interestingly the result has been satisfactory with the new
Generated files xls and pdf.
Negatively it has been the normal recorded file "control.dbf"
that the conversions go wrong, the accents and the "ñ" the theme dates
satisfactorily goes well, with the corrections made by
José Manuel "SALINETAS24".
If a partner can study this topic it would be interesting, I do not know if
Does the same thing happen in other languages that also have special signs?
The Prg source code, I have experienced saving it in both ANSI and
in UTF-8 if you give no result. See ---"Error.Zip"
regards
Mustafa
Attachments
Error.zip
(343.03 KiB) Downloaded 225 times
User avatar
andyglezl
Posts: 1461
Joined: Fri Oct 26, 2012 7:58 pm
Location: Guadalajara Jalisco, MX
Contact:

Re: Dbf To Excel(Excel Functions)

Post by andyglezl »

Aquí le dejo otro ejemplo "minimalista"
El tema de los acentos no lo he visto, quizá luego.
---------------------------------------------------------------
Here I leave another example "minimalist"
The theme of the accents I have not seen, maybe later.

main.zip
(928 Bytes) Downloaded 293 times
Andrés González López
Desde Guadalajara, Jalisco. México.
Post Reply