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
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
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*