Converte Xls(s) into dbf

[Silvio.Falconi]

I not understood how I can converte a file into dbf from excel
Please I have this file

on this file there are 37 columns and 67 rows
the first column is the name of the teacher and then there is the timetable for each teacher
the columns are he Hour of the days of week

Monday
Tuesday
Wednesday
Thursday
Friday
Saturday

every day 6 hours ( 6 columns)

Total 1 teacher+ 36 ( days Hours)





Any solution ?

[karinha]

Code: Select all  Expand view  RUN

// Exemplos no FiveWin Brasil:

/*
http://fivewin.com.br/index.php?/topic/ ... resolvido/

http://fivewin.com.br/index.php?/topic/ ... resolvido/
*/


// By Manuel Mercado

#include "FiveWin.ch"
#include "TSBrowse.CH"
//#include "TSButton.CH"

#define CLR_HBROWN    nRGB( 205, 192, 176 )

REQUEST DBFCDX

STATIC oWnd, aRedir, nFrom, nDest

//--------------------------------------------------------------------------------------------------------------------//

Function Main()

   Local oMenu, oIco

   SET DATE BRITISH
   SET EPOCH TO Year( Date() ) - 70

   MENU oMenu
      MENUITEM "Archivo"
         MENU
            MENUITEM "Create &Excel Sheet" ACTION fExcelDbf( ,, .F.)
            MENUITEM "Create &Database" ACTION fExcelDbf()
            MENUITEM "E&xit" ACTION oWnd:End()
         ENDMENU
      MENUITEM "E&xit" ACTION oWnd:End()
   ENDMENU

   DEFINE WINDOW oWnd MENU oMenu TITLE "From Excel To Dbf or Visceversa"
   ACTIVATE WINDOW oWnd MAXIMIZED ON INIT fExcelDbf()

Return Nil

//--------------------------------------------------------------------------------------------------------------------//

Function fExcelDbf( cXls, cDbf, lXls )

   Local oDlg, aCtl[ 9 ], lActivate, oFont, nVer, ;
         nAvance := 0

   Default cXls  := Padr( "Libro1.xls", 60 ), ;
           cDbf  := Padr( "Base1.dbf", 60 ), ;
           lXls  := .T.

   nVer := If( lXls, 1, 2 )
   lActivate := lXls

   DEFINE FONT oFont NAME "MS Sans Serif" SIZE 0, -11

   DEFINE DIALOG oDlg FROM 0, 0 TO 202, 380 PIXEL FONT oFont ;
          COLORS CLR_BLACK, CLR_HBROWN ;
          TITLE "Excel/Database/Excel"

   oDlg:nStyle := nOr( oDlg:nStyle, 4 )

   @ 11, 6 SAY aCtl[ 1 ] PROMPT "Database" OF oDlg ;
            FONT oFont UPDATE ;
            COLORS CLR_BLACK, CLR_HBROWN SIZE 39, 9 PIXEL

   @ 11, 45 GET aCtl[ 2 ] VAR cDbf OF oDlg SIZE 141, 10 PIXEL COLOR CLR_BLACK, CLR_WHITE FONT oFont ;
            ACTION ( cDbf := PadR( cGetFileName( .F. ), 60 ), aCtl[ 2 ]:Refresh() ) Bitmap "Find16"

   @ 27, 6 SAY aCtl[ 3 ] PROMPT "Excel File" OF oDlg ;
            FONT oFont UPDATE ;
            COLORS CLR_BLACK, CLR_HBROWN SIZE 39, 9 PIXEL

   @ 27, 45 GET aCtl[ 4 ] VAR cXls OF oDlg SIZE 141, 10 PIXEL COLOR CLR_BLACK, CLR_WHITE FONT oFont ;
            ACTION ( cXls := PadR( cGetFileName(), 60 ), aCtl[ 4 ]:Refresh() ) Bitmap "Find16"

   @ 43, 31 CheckBox aCtl[ 5 ] VAR lActivate OF oDlg ;
            PROMPT "Abrir Excel" FONT oFont UPDATE SIZE 50, 16 PIXEL

   @ 39, 82 Radio aCtl[ 6 ] Var nVer PROMPT "Xls/Dbf", "Dbf/Xls" Of oDlg Size 200, 10 Pixel
//            ALIGN DT_CENTER ;
//            COLORS CLR_BLACK, CLR_HBROWN, CLR_WHITE, CLR_GRAY, ;
//                   CLR_BLACK

   @ 66, 36 BUTTON aCtl[ 7 ] PROMPT "&Ok" OF oDlg ;
            ACTION ( If( nVer == 1, fXls2Dbf( cXls, cDbf, aCtl[ 9 ] ), ;
                                    fDbf2Xls( cXls, cDbf, aCtl[ 9 ], lActivate ) ), oDlg:End() ) ;
            FONT oFont SIZE 38, 12 PIXEL

   @66, 99 BUTTON aCtl[ 8 ] PROMPT "&Exit" OF oDlg ;
            ACTION oDlg:End() ;
            FONT oFont SIZE 38, 12 PIXEL

   @ 86,  6 METER aCtl[ 9 ] VAR nAvance OF oDlg TOTAL 100 ;
            PROMPT "Avance" SIZE 178, 12 PIXEL FONT oFont ;
            COLORS CLR_HBROWN, CLR_BLACK ;
            BARCOLOR CLR_HBLUE, CLR_YELLOW

   ACTIVATE DIALOG oDlg CENTERED VALID ( oFont:End(), .T. )

Return Nil

//--------------------------------------------------------------------------------------------------------------------//

Static Function fXls2Dbf( cXls, cDbf, oMtr, nTitRow, nDatRow )

   Local oExcel, oSheet, nRows, nCols, nRow, nCol, uData, nEle, nStep, ;
         nAvance := 0, ;
         aCampos := {}

   Default aRedir := {}

   If Empty( cXls )
      Return Nil
   EndIf

   CursorWait()
   cXls := UppCap( StrTran( Upper( AllTrim( cXls ) ), ".XLS" ) + ".XLS" )

   Default cDbf    := UppCap( StrTran( Upper( cXls ), ".XLS" ) ), ;
           nTitRow := 1, ;
           nDatRow := 2

   If ! File( Lfn2Sfn( cXls ) )
      CursorArrow()
      MsgStop( "Unexist File", cXls )
      Return Nil
   EndIf

   oExcel := TOleAuto():New( "Excel.Application" )
   oExcel:WorkBooks:Open( cXls )
   oSheet := oExcel:Get( "ActiveSheet" )
   nRows := oSheet:UsedRange:Rows:Count()
   nCols := oSheet:UsedRange:Columns:Count()
   oMtr:cText := "Creando Base de Datos"
   oMtr:nTotal := nCols + ( nCols * nRows )
   oMtr:Set( nAvance )
   oMtr:Refresh()
   nStep := Max( 1, Int( oMtr:nTotal * .03 ) )

   For nCol := 1 To nCols

      If ValType( oSheet:Cells( nDatRow, nCol ):Value ) = "C"
         AAdd( aCampos, { PadR( oSheet:Cells( nTitRow, nCol ):Value, 10 ), "C", 80, 0 } )

      ElseIf ValType( oSheet:Cells( nDatRow, nCol ):Value ) = "N"
         AADD( aCampos, { PadR( oSheet:Cells( nTitRow, nCol ):Value, 10 ), "N", 13, 0 } )

      ElseIf ValType( oSheet:Cells( nDatRow, nCol ):Value ) = "L"
         AADD( aCampos, { PadR( oSheet:Cells( nTitRow, nCol ):Value, 10 ), "L", 1, 0 } )

      ElseIf ValType( oSheet:Cells( nDatRow, nCol ):Value ) = "D"
         AADD( aCampos, { PadR( oSheet:Cells( nTitRow, nCol ):Value, 10 ), "D", 8, 0 } )
      Else
         AADD( aCampos, { PadR( oSheet:Cells( nTitRow, nCol ):Value, 10 ), "C", 80, 0 } )
      ENDIf

      oMtr:Set( ++ nAvance )
      SysRefresh()

   Next

   CursorArrow()

   If Empty( aCampos := aEditCampos( aCampos, cDbf ) )
      oExcel:Quit()
      Return Nil
   EndIf

   CursorWait()
   For nRow := 1 To Len( aCampos )
   Next
   DbCreate( cDbf, aCampos )
   Use ( cDbf ) New

   For nRow := nDatRow To nRows

      APPEND BLANK

      For nCol := 1 To nCols

         uData := oSheet:Cells( nRow, nCol ):Value
         nEle := aRedir[ AScan( aRedir, {|e| e[ 1 ] == nCol } ), 2 ]

         If aCampos[ nEle, 2 ] == "C"

            If ValType( uData ) == "N"
               uData := Mask( uData,,, .F., .F., .F. )
            Else
               uData := VtoC( uData )
           EndIf

         ElseIf aCampos[ nEle, 2 ] == "N"
            uData := VtoN( uData )
         ElseIf aCampos[ nEle, 2 ] == "D"
            uData := CtoD( VtoC( uData ) )
         EndIf

         FieldPut( nEle, uData )

         If ( ++ nAvance % nStep ) == 0
            oMtr:Set( nAvance )
         EndIf

         SysRefresh()

      Next

   Next

   DbCloseArea()
   oExcel:Quit()
   oMtr:Set( oMtr:nTotal )
   oMtr:Refresh()
   CursorArrow()

Return Nil

//--------------------------------------------------------------------------------------------------------------------//

Static Function fDbf2Xls( cXls, cDbf, oMtr, lActivate, cInd, cDrv, cTitle )

   Local oExcel, oSheet, oClip, oRange, nCol, cLet, nTotCol, nTotRow, nAvance, uData, ;
         nRow := 1, ;
         aCol := { 26, 52, 78, 104, 130, 156 }, ;
         aLet := { "", "A", "B", "C", "D", "E" }, ;
         lCdx := .F., ;
         cText := ""

   If Empty( cDbf )
      Return Nil
   EndIf

   CursorWait()
   cDbf := AllTrim( StrTran( Upper( cDbf ), ".DBF" ) )
   cDbf += ".DBF"

   cInd := If( Empty( cInd ), "", AllTrim( Upper( cInd ) ) )

   If ! Empty( cInd )

      If At( ".", cInd ) > 0
         lCdx := "CDX" $ cInd
      ElseIf File( cInd + ".CDX" )
         lCdx := .T.
      EndIf

   EndIf

   Default cDrv := If( lCdx, "DBFCDX", "DBFNTX" )

   If ! File( Lfn2Sfn( cDbf ) )
      CursorArrow()
      MsgStop( "No Existe el Archivo", cDbf )
      Return Nil
   EndIf

   If ! Empty( cInd )
      Use cDbf Shared New VIA cDrv
      Set Index To ( cInd )
   Else
      Use ( cDbf ) Shared New VIA cDrv
   EndIf

   nTotRow := If( ! Empty( cInd ) .and. lCdx, OrdKeyCount(), LastRec() )
   nTotCol := Min( Fcount(), 156 )

   If Empty( nTotRow )
      DbCloseArea()
      CursorArrow()
      MsgStop( "Base de datos vacía", "Error" )
      Return Nil
   EndIf

   oMtr:cText := "Creando hoja de Excel"
   oMtr:nTotal := nTotRow + nTotCol
   oMtr:Set( nAvance := 0 )
   oMtr:Refresh()
   oExcel := TOleAuto():New( "Excel.Application" )
   oExcel:WorkBooks:Add()
   oSheet := oExcel:Get( "ActiveSheet" )
   cLet := aLet[ AScan( aCol, {|e| nTotCol <= e } ) ]

   If ! Empty( cLet )
      nEle := AScan( aLet, cLet ) - 1
      cLet += Chr( 64 + nTotCol - aCol[ Max( 1, nEle ) ] )
   Else
      cLet := Chr( 64 + nTotCol )
   EndIf

   If ! Empty( cTitle )
      cText += cTitle + Chr( 13 )
   EndIf

   For nCol := 1 To nTotCol
      cText += UppCap( FieldName( nCol ) ) + Chr( 9 )
      nAvance ++
      oMtr:Set( nAvance )
      SysRefresh()
   Next

   cText += Chr( 13 )
   DbGoTop()
   nStart := nRow := 1

   While ! EoF()

      For nCol := 1 To nTotCol

         uData := FieldGet( nCol )
         uData  :=  If( ValType( uData )=="D", DtoC( uData ), If( ValType( uData )=="N", Str( uData ) , ;
                    If( ValType( uData )=="L", If( uData ,".T." ,".F." ), VtoC( uData ) ) ) )

         cText += AllTrim( uData ) + Chr( 9 )

      Next

      cText += Chr( 13 )
      nRow ++

      IF Len( cText ) > 20000
         oClip := TClipBoard():New()
         oClip:Clear()
         oClip:SetText( cText )
         oRange := oSheet:Range( "A" + LTStr( nStart ) )
         oRange:Select()
         oSheet:Paste()
         oClip:End()
         cText := ""
         nStart := nRow + 1
      EndIf

      DbSkip()
      nAvance ++
      oMtr:Set( nAvance )
      SysRefresh()

   EndDo

   If ! Empty( cText )
      oClip := TClipBoard():New()
      oClip:Clear()
      oClip:SetText( cText )
      oRange := oSheet:Range( "A" + LTStr( nStart ) )
      oRange:Select()
      oSheet:Paste()
      oClip:End()
   EndIf

   oSheet:Range( "A1:" + cLet + "1" ):Set( "HorizontalAlignment", 7 )
   cRange := "A" + If( ! Empty( cTitle ), "3", "1" ) + ":" + cLet + LTStr( oSheet:UsedRange:Rows:Count() )
   oSheet:Range( cRange ):Borders():LineStyle := 1
   oSheet:Columns( "A:" + cLet ):AutoFit()
   DbCloseArea()

   If lActivate
      oExcel:Visible := .T.
   EndIf

   oExcel:Quit()
   oMtr:Set( oMtr:nTotal )
   CursorArrow()

Return Nil

//--------------------------------------------------------------------------------------------------------------------//

Static Function aEditCampos( aCampos, cDbf )

   Local oDlg, oBrw, oFont, cGet, cAnt, cSay, aCtl[ 10 ], oDrCur, nBase, nEle, ;
         aDbf     := aCampos, ;
         lOk      := .F., ;
         lRenamed := .F., ;
         lCopy    := .F., ;
         nAvance  := 0, ;
         aCla     := { "C", "N", "D", "L", "M" }, ;
         aTip     := { "Alfanumérico", "Numérico", "Fecha", "Lógico", "Memo" }

   aRedir := {}

   cGet := cAnt := If( At( "\", cDbf ) > 0, cDbf, cFilePath( GetModuleFileName( GetInstance() ) ) + cDbf )
   cSay := "Campo 1" + Space( 3 ) + Trim( aDbf[ 1, 1 ] )

   For nEle := 1 To Len( aDbf )
      AAdd( aRedir, { nEle, nEle } )
   Next

   DEFINE FONT oFont NAME "MS Sans Serif" SIZE 0, -8
   DEFINE CURSOR oDrCur RESOURCE "Drag"

   DEFINE DIALOG oDlg FROM 0, 0 TO 388, 380 PIXEL FONT oFont ;
          STYLE nOr( WS_POPUP, WS_BORDER ) ;
          COLOR CLR_BLACK, CLR_HBROWN

   @  0,  0 SAY aCtl[ 1 ] PROMPT "Crear Base de Datos" OF oDlg ;
            SIZE 192, 9 PIXEL CENTER ;
            COLOR CLR_WHITE, CLR_BLUE FONT oFont

   @ 13, 20 Group aCtl[ 2 ] To 29, 192 OF oDlg LABEL "Guardar Como" ;
            PIXEL

   @ 19, 23 SAY aCtl[ 3 ] VAR cGet SIZE 142, 8 PIXEL OF oDlg BORDER

   @ 51, 20 SAY aCtl[ 5 ] VAR cSay OF oDlg SIZE 148, 8 PIXEL ;
            COLOR CLR_WHITE, 8323200 BORDER CENTER

   @ 61, 20 BROWSE aCtl[ 6 ] ARRAY aDbf OF oDlg CELLED SIZE 148, 93 PIXEL ;
            COLORS CLR_BLACK, CLR_WHITE, CLR_BLACK, CLR_HGRAY, CLR_WHITE, CLR_BLACK

   aCtl[ 6 ]:bChange := { || cSay := "Campo" + Space( 1 ) + ;
                             LTStr( aCtl[ 6 ]:nAt ) + Space( 3 ) + ;
                          If( aCtl[ 6 ]:nAt > 0 .and. ;
                              Len( aCtl[ 6 ]:aArray ) > 0 .and. ;
                              ! aCtl[ 6 ]:lAppendMode, ;
                              aCtl[ 6 ]:aArray[ aCtl[ 6 ]:nAt ][ 1 ], "" ), ;
                              aCtl[ 5 ]:Refresh() }


   ADD COLUMN TO aCtl[ 6 ] DATA ARRAY ELM 1 TITLE "Nombre" ;
       VALID { |uVar| ! Empty( uVar ) } PICTURE "@K!" ;
       ALIGN DT_LEFT, DT_CENTER SIZE 80 PIXELS ;
       POSTEDIT { || lRenamed := If( aCtl[ 6 ]:lChanged, .T., lRenamed ) } ;
       EDITABLE MOVE DT_MOVE_RIGHT

   ADD COLUMN TO aCtl[ 6 ] COMBOBOX TITLE "Tipo" ;
       DATA ComboWBlock( aCtl[ 6 ], 2, 2, { aTip, aCla } ) ;
       ALIGN DT_LEFT, DT_CENTER SIZE 70 PIXELS ;
       EDITABLE MOVE DT_MOVE_NEXT ;
       POSTEDIT { |v,o,c| c := o:aArray[ o:nAt, 2 ], o:aArray[ o:nAt, 3 ] := ;
                  If( c == "L", 1, If( c == "D", 8, o:aArray[ o:nAt, 3 ] ) ), ;
                  o:aArray[ o:nAt, 4 ] := If( c != "N", 0, o:aArray[ o:nAt, 4 ] ) }

   ADD COLUMN TO aCtl[ 6 ] DATA ARRAY ELM 3 TITLE "Longitud" ;
       WHEN ( aCtl[ 6 ]:aArray[ aCtl[ 6 ]:nAt, 2 ] $ "CN" ) ;
       PICTURE "@K!" ALIGN DT_LEFT SIZE 55 PIXELS ;
       EDITABLE MOVE DT_MOVE_NEXT

   ADD COLUMN TO aCtl[ 6 ] DATA ARRAY ELM 4 TITLE "Decimales" ;
       WHEN aCtl[ 6 ]:aArray[ aCtl[ 6 ]:nAt, 2 ] == "N" ;
       VALID { |uVar| uVar <= 9 } ;
       PICTURE "@K" ALIGN DT_RIGHT, DT_CENTER SIZE 65 PIXELS ;
       EDITABLE MOVE DT_MOVE_NEXT

   aCtl[ 6 ]:lNoHScroll := .T.
   aCtl[ 6 ]:lNoExit := .T.
   aCtl[ 6 ]:SetAppendMode( .T. )
   aCtl[ 6 ]:SetDeleteMode( .T., .F. )
   aCtl[ 6 ]:aDefault := { Space( 10 ), "C", 10, 0 }
   aCtl[ 6 ]:bKeyDown := { |nKey| If( nKey = VK_INSERT, ( ASize( aCtl[ 6 ]:aArray, Len( aCtl[ 6 ]:aArray ) + 1 ), ;
                           AIns( aCtl[ 6 ]:aArray, aCtl[ 6 ]:nAt ), ;
                           aCtl[ 6 ]:aArray[ aCtl[ 6 ]:nAt ] := aCtl[ 6 ]:aDefault, ;
                           aCtl[ 6 ]:Refresh( .T. ) ), Nil ) }

   aCtl[ 6 ]:oDragCursor := oDrCur
   aCtl[ 6 ]:bDropOver := { |u,n| nDest := u[ 2 ]:GetTxtRow( n ), ;
                            fDropDrag( u[ 3 ], u[ 2 ]:GetTxtRow( n ), u[ 1 ], u[ 2 ] ) }
   aCtl[ 6 ]:bDragBegin = { |nRow,nCol,nFlags,x| nFrom := x:nAt, SetDropInfo( { x:nAt, x, x:nRowPos } ) }

   @158, 20 BUTTON aCtl[ 7 ] PROMPT "Crear" OF oDlg SIZE 40, 12 PIXEL ;
            ACTION ( aDbf := aCtl[ 6 ]:aArray, lOk := .T., oDlg:End() )

   @158,127 BUTTON aCtl[ 8 ] PROMPT "Salir" OF oDlg SIZE 40, 12 PIXEL ;
            ACTION oDlg:End() CANCEL

   oDlg:bGotFocus := { || aCtl[ 6 ]:SetFocus() }

   ACTIVATE DIALOG oDlg CENTERED ON INIT aCtl[ 6 ]:SetFocus() ;
            VALID ( oFont:End(), oDrCur:End(), .T. )

   If ! lOk
      aDbf := {}
   EndIf

Return aDbf

//--------------------------------------------------------------------------------------------------------------------//

Static Function cGetFileName( lXls )

   Default lXls := .T.

Return LongFileName( cGetFile32( If( lXls, "Libro Excel (*.xls) | *.xls", "Base de Datos (*.dbf) | *.dbf" ), ;
                       "Selecciona el Archivo",,, .F. ) )

//--------------------------------------------------------------------------------------------------------------------//

Static Function fDropDrag( nSourceRow, nTargetRow, nAt, oBrw )

   Local aItem, nEle, nAnt, nSkip

   If ! ( ValType( nSourceRow ) == "N" .and. ValType( nTargetRow ) == "N" .and. ;
          nSourceRow >= 1 .and. nTargetRow >= 1 .and. nSourceRow <= Len( oBrw:aArray ) .and. ;
          nTargetRow <= Len( oBrw:aArray ) )

      Return Nil

   EndIf

   nSkip := nTargetRow - nSourceRow

   If nSkip < 0

      nEle := AScan( aRedir, {|e| e[ 1 ] == nAt } )
      aRedir[ nEle, 2 ] := nAt + nSkip // nTargetRow

      For nAnt := 1 To ( nAt - 1 )
         aRedir[ nAnt, 2 ] ++
      Next

   Else

      nEle := AScan( aRedir, {|e| e[ 1 ] == nAt } )
      aRedir[ nEle, 2 ] := nTargetRow

      For nAnt := Len( aRedir ) To ( nAt + 1 ) Step -1
         aRedir[ nAnt, 2 ] --
      Next

   EndIf

   aItem := AClone( oBrw:aArray[ nAt ] )
   ADel( oBrw:aArray, nAt )
   nAt += nSkip
   AIns( oBrw:aArray, nAt )
   oBrw:aArray[ nAt ] := AClone( aItem )
   oBrw:Refresh()
   oBrw:lHasChanged := .T.

Return Nil

//--------------------------------------------------------------------------------------------------------------------//

Function fTraMsg()
Return Nil
//--------------------------------------------------------------------------------------------------------------------//

Function fManMsg()
Return Nil
//--------------------------------------------------------------------------------------------------------------------//

Static Function LongFileName( cShName )

   Local nLen, ;
         cBuffer := Space( 255 ), ;
         cFilNam := Space( 255 )

   cShName := AllTrim( cShName )
   nLen    := GetFullName( cShName, 255, @cBuffer, @cFilNam )

Return UppCap( Left( cBuffer, nLen ) )

//--------------------------------------------------------------------------------------------------------------------//

DLL32 Static Function GetFullName( cFileName AS STRING, nBuffer AS LONG, @lpBuffer AS STRING, @lpFilePart AS STRING ) ;
      AS LONG PASCAL FROM "GetFullPathNameA" LIB "kernel32.dll"

[Silvio.Falconi]

is this a poem or a Joke ?

Turbo Incremental Link 6.70 Copyright (c) 1997-2014 Embarcadero Technologies, Inc.
Error: Unresolved external '_HB_FUN_UPPCAP' referenced from C:\WORK\ERRORI\XLSTODBF\OBJ\TEST.OBJ
Error: Unresolved external '_HB_FUN_MASK' referenced from C:\WORK\ERRORI\XLSTODBF\OBJ\TEST.OBJ
Error: Unresolved external '_HB_FUN_VTOC' referenced from C:\WORK\ERRORI\XLSTODBF\OBJ\TEST.OBJ
Error: Unresolved external '_HB_FUN_VTON' referenced from C:\WORK\ERRORI\XLSTODBF\OBJ\TEST.OBJ
Error: Unresolved external '_HB_FUN_LTSTR' referenced from C:\WORK\ERRORI\XLSTODBF\OBJ\TEST.OBJ
Error: Unable to perform link

then I not have and not use sbrowse

[James Bott]

Export the data from Excel to a comma delimited file, then import to DBF.

[Silvio.Falconi]

the end user uses one of my programs to create teacher replacements. He must enter the time and from his schedule to create the timetable he can print it in xlx format. The columns for the timetable are: one for the teacher and 1 to max 10 for each day except Sunday. So I thought of a procedure to convert the xls file to a dbf file like this

Code: Select all  Expand view  RUN

Function Create_Dbf(cDir)


                    DBCREATE(cDir+'TA',;
                           {{'teacher','C',024,000},;
                            {'Mon1','C',004,000},;  // Monday
                            {'Mon2','C',004,000},;
                            {'Mon3','C',004,000},;
                            {'Mon4','C',004,000},;
                            {'Mon5','C',004,000},;
                            {'Mon6','C',010,000},;
                            {'Mon7','C',004,000},;
                            {'Mon8','C',004,000},;
                            {'Mon9','C',004,000},;
                            {'Mon10','C',010,000},;
                            {'Tue1','C',004,000},;   // Tuesday
                            {'Tue2','C',004,000},;
                            {'Tue3','C',004,000},;
                            {'Tue4','C',004,000},;
                            {'Tue5','C',004,000},;
                            {'Tue6','C',010,000},;
                            {'Tue7','C',004,000},;
                            {'Tue8','C',004,000},;
                            {'Tue9','C',004,000},;
                            {'Tue10','C',010,000},;
                            {'Wed1','C',004,000},;  //Wednesday
                            {'Wed2','C',004,000},;
                            {'Wed3','C',004,000},;
                            {'Wed4','C',004,000},;
                            {'Wed5','C',004,000},;
                            {'Wed6','C',010,000},;
                            {'Wed7','C',004,000},;
                            {'Wed8','C',004,000},;
                            {'Wed9','C',004,000},;
                            {'Wed10','C',010,000},;
                            {'Thu1','C',004,000},;  //Thursday
                            {'Thu2','C',004,000},;
                            {'Thu3','C',004,000},;
                            {'Thu4','C',004,000},;
                            {'Thu5','C',004,000},;
                            {'Thu6','C',010,000},;
                            {'Thu7','C',004,000},;
                            {'Thu8','C',004,000},;
                            {'Thu9','C',004,000},;
                            {'Thu10','C',010,000},;
                            {'Fri1','C',004,000},;  //Friday
                            {'Fri2','C',004,000},;
                            {'Fri3','C',004,000},;
                            {'Fri4','C',004,000},;
                            {'Fri5','C',004,000},;
                            {'Fri6','C',010,000},;
                            {'Fri7','C',004,000},;
                            {'Fri8','C',004,000},;
                            {'Fri9','C',004,000},;
                            {'Fri10','C',010,000},;
                            {'Sat1','C',004,000},;  //Saturday
                            {'Sat2','C',004,000},;
                            {'Sat3','C',004,000},;
                            {'Sat4','C',004,000},;
                            {'Sat5','C',004,000},;
                            {'Sat6','C',010,000},;
                            {'Sat7','C',004,000},;
                            {'Sat8','C',004,000},;
                            {'Sat9','C',004,000},;
                            {'Sat10','C',010,000},;
                           {'Matter','C',020,000}}, 'DBFCDX')  // Matter of teacher



close all
      use &(cDir+'TA') new
      select TA
      if FILE(cDir+'Tabella.DBF')
         delete file &(cdir+'Tabella.cdx')
         append from &(cdir+'Tabella')
         dbcommitall()
         close all
         delete file &(cdir+'Tabella.dbf')
      endif
      close all
      rename &(cdir+'Ta.dbf') to &(cdir+'Tabella.dbf')

return nil
//---------------------------------------------------------------------------------//

Once converted into this file, I have to convert it another to the archive format that I use in my program like this

Code: Select all  Expand view  RUN

dbcreate(cDir+'LZ',;
        {{"prof      ", "n", 3, 0},;   //teacher
         {"classe    ", "c", 4, 0},;  // class
         {"aula      ", "c", 4, 0},;  // room
         {"materia   ", "n", 3, 0},;  // matterof teacher
         {"flag      ", "c", 1, 0},;       // not
         {"gruppo    ", "n", 3, 0},;    // not
         {"oreseq    ", "c", 1, 0},;    // not
         {"gg_ora    ", "c", 2, 0}, ;  //  - >day_hour
         {"blocco    ", "c", 1, 0}}, 'DBFCDX' )  // Not
 

I hope you understood me

[Silvio.Falconi]

using the NagesRao note I found on this forum I created this test

It create Tabella.dbf and then call Orario.xls and converte it on dbf

Code: Select all  Expand view  RUN

#include "fivewin.ch"

#include "ord.ch"
#include "dtpicker.ch"

REQUEST HB_Lang_IT
REQUEST HB_CODEPAGE_ITWIN


REQUEST DBFCDX
REQUEST DBFFPT
EXTERNAL ORDKEYNO,ORDKEYCOUNT,ORDCREATE,ORDKEYGOTO

FUNCTION Main()

    HB_LangSelect("IT")
    HB_SetCodePage("ITWIN")

    SET _3DLOOK ON
    SET CENTURY ON
    SET DATE ITALIAN

   RDDSetDefault( 'DBFCDX' )

    Converte_Orario()
   RETURN NIL



// converte Orario.Xls to Dbf
Function Converte_Orario()
Local oRange,lOpened:=.f.

           Local cDir:= ".\"
                  Create_Dbf(cDir)


oRange := GetExcelRange("C:\Work\Errori\xlstodbf\orario.xls" , , @lOpened)

USE tabella ALIAS TA
SELECT TA

FW_ExcelToDBF( oRange, nil, .t. )

xbrowse(oRange)
oRange := NIL


RETURN NIL
//-------------------------------------------------------------------------//
Function Create_Dbf(cDir)


                    DBCREATE(cDir+'TA',;
                           {{'teacher','C',024,000},;
                            {'Mon1','C',004,000},;  // Monday
                            {'Mon2','C',004,000},;
                            {'Mon3','C',004,000},;
                            {'Mon4','C',004,000},;
                            {'Mon5','C',004,000},;
                            {'Mon6','C',010,000},;
                            {'Mon7','C',004,000},;
                            {'Mon8','C',004,000},;
                            {'Mon9','C',004,000},;
                            {'Mon10','C',010,000},;
                            {'Tue1','C',004,000},;   // Tuesday
                            {'Tue2','C',004,000},;
                            {'Tue3','C',004,000},;
                            {'Tue4','C',004,000},;
                            {'Tue5','C',004,000},;
                            {'Tue6','C',010,000},;
                            {'Tue7','C',004,000},;
                            {'Tue8','C',004,000},;
                            {'Tue9','C',004,000},;
                            {'Tue10','C',010,000},;
                            {'Wed1','C',004,000},;  //Wednesday
                            {'Wed2','C',004,000},;
                            {'Wed3','C',004,000},;
                            {'Wed4','C',004,000},;
                            {'Wed5','C',004,000},;
                            {'Wed6','C',010,000},;
                            {'Wed7','C',004,000},;
                            {'Wed8','C',004,000},;
                            {'Wed9','C',004,000},;
                            {'Wed10','C',010,000},;
                            {'Thu1','C',004,000},;  //Thursday
                            {'Thu2','C',004,000},;
                            {'Thu3','C',004,000},;
                            {'Thu4','C',004,000},;
                            {'Thu5','C',004,000},;
                            {'Thu6','C',010,000},;
                            {'Thu7','C',004,000},;
                            {'Thu8','C',004,000},;
                            {'Thu9','C',004,000},;
                            {'Thu10','C',010,000},;
                            {'Fri1','C',004,000},;  //Friday
                            {'Fri2','C',004,000},;
                            {'Fri3','C',004,000},;
                            {'Fri4','C',004,000},;
                            {'Fri5','C',004,000},;
                            {'Fri6','C',010,000},;
                            {'Fri7','C',004,000},;
                            {'Fri8','C',004,000},;
                            {'Fri9','C',004,000},;
                            {'Fri10','C',010,000},;
                            {'Sat1','C',004,000},;  //Saturday
                            {'Sat2','C',004,000},;
                            {'Sat3','C',004,000},;
                            {'Sat4','C',004,000},;
                            {'Sat5','C',004,000},;
                            {'Sat6','C',010,000},;
                            {'Sat7','C',004,000},;
                            {'Sat8','C',004,000},;
                            {'Sat9','C',004,000},;
                            {'Sat10','C',010,000}}, 'DBFCDX')



close all
      use &(cDir+'TA') new
      select TA
      if FILE(cDir+'Tabella.DBF')
         delete file &(cdir+'Tabella.cdx')
         append from &(cdir+'Tabella')
         dbcommitall()
         close all
         delete file &(cdir+'Tabella.dbf')
      endif
      close all
      rename &(cdir+'Ta.dbf') to &(cdir+'Tabella.dbf')

return nil
//---------------------------------------------------------------------------------//

But i not see any data into dbf

But My friend Nages sad me "Please make sure the datatypes of Excel columns and FieldTypes of the DBF match."

I explain there is a problem because

Each day from Monday to Saturday the Hour can be from 1 to 10 Hour

For a sample on Orario.xls the configuration is
Monday 5
Tuesday 6
Wednesday 5
Thursday 6
Friday 5
Saturday 5

this configuration can be read from datis.dbf look this


But I not Know the configuration and the end use must insert this at init before to converte the file

Someone can help me

[Silvio.Falconi]

Now I resolve to converte Orario.xls to My dbf ( but I made only the first step)
the error is as Nages sad me "...Please make sure the datatypes of Excel columns and FieldTypes of the DBF match."
I rename all Excel colums



Now I must converte the Tabella.dbf into Orario.dbf

Code: Select all  Expand view  RUN

dbcreate(cDir+'LZ',;
        {{"prof      ", "n", 3, 0},;   //teacher
         {"classe    ", "c", 4, 0},;  // class
         {"aula      ", "c", 4, 0},;  // room
         {"materia   ", "n", 3, 0},;  // matter of teacher
         {"flag      ", "c", 1, 0},;       // not
         {"gruppo    ", "n", 3, 0},;    // not
         {"oreseq    ", "c", 1, 0},;    // not
         {"gg_ora    ", "c", 2, 0}, ;  //  - >day_hour
         {"blocco    ", "c", 1, 0}}, 'DBFCDX' )  // Not

But now I think it not is hard to make

the teacher must be save on Docenti.dbf from docenti I take the number
and save it on Lz.dbf to field prof
then take Mon1 if not empty I have into gg_ora the dayand the hour Mon=1 -> 11
then save the value of Mon1 into classe field
and this for each day ..
then save the matter of teachers ( last column)

it must become as this



It might work well even though I still have many doubts

[James Bott]

the end user uses one of my programs to create teacher replacements. He must enter the time and from his schedule to create the timetable he can print it in xlx format.

Hmm, what about him entering the data in your program, then exporting to Excel for printing?

Is there something special about the Excel printout? Can you just print it from your app also?

[nageswaragunupudi]

Mr Silvio

Let me explain the functionality of FW_ExcelToDBF()

Code: Select all  Expand view  RUN

FW_ExcelToDBF( oExelRange, ;    // Excel Range object
               [cFieldList], ;  // Optional ( now we will omit this)
               [lRangeHasHeaders] ) // Now set it to True
 

Your Excel sheet has headers in the first row. So, set the 3rd parameter to .T. You have already done this.

The function copies the contents of a column to the field in dbf with the FieldName same as the Header in the Excel Range.

Example:
If the headers in the Excel sheet are "PROF", "CLASSE", "FLAG", "AULA" ..
Then this function copies the contents of these columns to the fields with FieldNames "PROF", "CLASSE", "FLAG", "AULA", ..., even if the order is different in Excel and DBF.

So, please make sure that the Headers in the Excel sheet are correctly spelled and match the field names in the DBF. They need not be in the same order.

Another case:
Let us consider other case, where the headers of Excel sheet doe not match with any field names of the DBF. Assume that we can not or do not want to edit and modify the header names in the Excel sheet.

We want columns 1,2,3,4 of the sheet to be copied to fields "PROF,CLASSE,FLAG,AULA". Then :

FW_ExcelToDBF( oRange, "PROF,CLASSE,FLAG,AULA", .t. )
In case the excel sheet does not contain a header row at all, then:
FW_ExcelToDBF( oRange, "PROF,CLASSE,FLAG,AULA", .f. )

DataTypes:
It is safe if the data types used match the field types in the DBF. Even otherwise, the function makes best efforts to conver the type to match the field type in DBF, but this may not be possible in all cases.
In your case that is not a problem, because all fields in your DBF are character type. In this case whatever the data type in Excel, the function converts them to character value and write to the DBF.

If you still have any doubts please feel free to ask.

[Silvio.Falconi]

Mr Rao,
All it is ok

First I must converte Xls into tabella.dbf and it is ok ( I fogot to set the same field on xls and dbf)

then I must converte tabella.dbf into Orario.dbf ( to hand)

because I must insert before the name of the teacher and save on Docenti.dbf , It must return the number of Record

this number must be saved in the Prof field of orario.dbf then for each column I have to save the day / time and the class and then also the subject of teaching (this subject must be saved in the file materia.dbf) I thought less messy but unfortunately I have to do the conversion by hand from Table.dbf in Orario.dbf.

The only thing I can ask you is this:

each end user inserts a sheet of excel and if the fields must be equal to the dbf the user must change the columns of excel or how could it be done to do it automatically?
keep in mind that I need for each record the name of the teacher then for each day a week the class from 1 to 10 hours max and then the subject of teaching

[nageswaragunupudi]

Please try using the method I suggested under the heading "Another case"

[Silvio.Falconi]

Conversion from xls to temporaney dbf made ok (thanks Rao)

Conversion from temporaney dbf to my orario.dbf made ok ( thanks Cristobal for hb_aTokens)

the procedure save on teacher archive, in classroom archive, in room archive and on orario.dbf


the last problem is that you can see on this picture




this happened because if the procedure not save the matter ( or the matter is empty) the color of the matter is 0 ( black)

How I can resolve it ?

I ask to end user to insert on xls a column with the matter od the teacher but I cannot ask to end user to insert also the color

How I can to insert a randomize color for each matter ?


how I resolve it ?

[James Bott]

Here is an example of how to set the color of a cell based on a condition.

oBrw:aCols[1]:bClrStd:= { || {CLR_BLACK, if( cust->balance >0, CLR_RED, CLR_WHITE) } }

Make sure you place the above line AFTER the column has been defined or it will error out with an "array access" error.

[Marc Venken]

This works for me..

Code: Select all  Expand view  RUN

     oBrw[6]:aCols[1]:bClrStd := { || IF( oRs:selection , { CLR_BLACK,CLR_HGREEN } , { CLR_HRED,CLR_WHITE } ) }
     oBrw[6]:T1:bClrStd := { || showcolors(oBrw[6]:T1:Value)  }
     oBrw[6]:T2:bClrStd := { || showcolors(oBrw[6]:T2:Value)  }
     oBrw[6]:T3:bClrStd := { || showcolors(oBrw[6]:T3:Value)  }
     oBrw[6]:T4:bClrStd := { || showcolors(oBrw[6]:T4:Value)  }
     oBrw[6]:T5:bClrStd := { || showcolors(oBrw[6]:T5:Value)  }
...

function showcolors(cVeld)
  local cKleur:=""
  local aColorPairs := { ;
  { CLR_BLACK, MY_LIGHTGREEN },;  //1
  { CLR_BLACK, MY_GREEN},;        //2
  { CLR_BLACK, MY_PAARS},;        //3
  { CLR_BLACK, MY_LIGHTYELLOW },; //4
  { CLR_BLACK, MY_YELLOW }}       //5

  do case
    case cVeld = "T"
       cKleur = aColorPairs[2]
    case cVeld = "W"
       cKleur = aColorPairs[3]
    case cVeld = "A"
       cKleur = aColorPairs[5]
    otherwise
       cKleur = aColorPairs[1]
  endcase
return cKleur

 

[Silvio.Falconi]

Maybe I did not say it clear enough .

The colors in the xbrowse in my program run well

BUT this is not the problem.
When the end user wants to load the timetable from an Excel file does not insert the colors for the individual boxes so not knowing what the colors are,
then xbrowse does not work well because that timetable takes the colors from the classes that are inserted into another archive
and at the time of the xls file failure I can not ask the end user

then I created an array and I added about 200 colors and I solved the problem even if sometimes a dark color has happened and then you do not see the clear classes.

The end user after uploading the excel file must still go to that archive to set the colors well.

I did not find another solution