Jump to content
Fivewin Brasil

Excel -> DBF (Resolvido)

crisvam

By crisvam
in Programação

 Share

Recommended Posts

crisvam Newbie

crisvam

Posted
Posted

Pessoal,

 

Tem como pegar os dados de uma tabela em excel e transferir para um arquivo DBF via Fivewin

 

Grato a todos pela força

 

Obrigado a Theotokos e gbSilva, resolvi com a dica do gbSilva fiz algumas adaptações para o meu banco de dados

 

Fiquem com Deus

Link to comment
Share on other sites
Theotokos Apprentice

Theotokos

Posted
Posted

Existe uma Classe tExcel

 

/*
 * Clase TExcelScript v1.14  06-Feb-2004
 *
 * Esta Clase usa la Libreria Ole2 de José F. Giménez
 *
 * Autor: Víctor Manuel Tomas Díaz [Vikthor]
 *
 * Modificaciones y agregados realizadas por:
 * Daniel Andrade - [AD2K] 26/08/2002
 * Rimantas Usevicius - [RimUs] 25-09-2002
 * Carlos Sincur Romero - [CSR] 4/9/2002
 * El Browse es un concepto original de René Flores , adaptado a esta clase.
 *
 * Nuevos metodos   [ Vikthor ]   7-Oct-2003
   ++ METHOD Headers( nOpc , cVal )
   ++ METHOD Footers( nOpc , cVal )
   ++ METHOD Margins( nOpc , nVal )
   ++ METHOD SetPrintArea(cRange)
   ++ METHOD lCenterH( lCenter)
   ++ METHOD lCenterV( lCenter)
   ++ METHOD Zoom( nZoom )
   ++ METHOD SetPage( nPage  )
 
 * Nuevos metodos   [ Vikthor ]   10-Nov-2003
 
   ++ METHOD SendMail( cMail , cSubject , lReturn )
   ++ METHOD MailSystem()     // Devuelve el sistema de correo de la maquina
   ++ METHOD WebPagePreview() // Genera una vista en HTML del libro.
   ++ METHOD AddPicture( cFile, nRow , nCol , nWidth , nHeight ) // Agrega un imagen
   ++ METHOD AddShape( nShape, nLeft , nTop , nWidth , nHeight ) // Agrega un forma
   ++ METHOD Dialog( nTypeDlg )
 
 
 * Nuevos metodos   [ Vikthor ]   06-Feb-2004
   ++   METHOD SendeMail( cSender, cSubject, lShowMessage, lIncludeAttachment) // [ Vikthor ]
   ++   METHOD ProtectBook( cPassword )    // [ Vikthor ]
   ++   METHOD ProtectSheet( cPassword )   // [ Vikthor ]
   ++   METHOD UnProtectBook( cPassword )  INLINE ::oBook:Invoke( 'UnProtect' , cPassword  ) // [ Vikthor ]
   ++   METHOD UnProtectSheet( cPassword ) INLINE ::oSheet:Invoke( 'UnProtect' , cPassword  ) // [ Vikthor ]
   ++   METHOD Protect( cPassword )        INLINE ::ProtectBook( cPassword ) , ::ProtectSheet( cPassword ) // [ Vikthor ]
   ++   METHOD UnProtect( cPassword )      INLINE ::UnProtectBook( cPassword ) , ::UnProtectSheet( cPassword ) // [ Vikthor ]
 
 * Nuevos metodos   [ Vikthor ]   06-Jul-2004
 
   ++   FormatRange( cRange , nColor )
 
 * Nuevos metodos   [ Vikthor ]   13-Jul-2004
 
    ++ CountSheets()
    ++ SeekSheet()
   ++ HowSheet()
   DATA nSheets
   DATA aSheets
 
 * Nuevos metodos   [ Vikthor ]   07-Abr-2005
 
   ++   METHOD HPageBreaks( oCell )     INLINE ::oSheet:HPageBreaks:Add( "Before" , oCell ) // [ Vikthor ]
 
 * Nuevos metodos   [ Vikthor ]   08-Abr-2005
 
   ++   METHOD Formula( nRow , nCol , uValue )                                              // [ Vikthor ]
   ++   ERROR HANDLER ERROR()                                                                 // [ Vikthor ]
 
 
 * Nuevos metodos   [ Vikthor ]   14-Abr-2005
   ++  METHOD nBooks()                                                                 // [ Vikthor ]
   ++  METHOD SeekBook()
   ++  METHOD HowBook()
       DATA nBooks
       DATA aBooks
 
oExcel:Workbooks:OpenText( cFile , 3 , 1 , 1 , 1 , .F. , .T.  , .T. )
// [eof]
 
 */
 
# include "FiveWin.Ch"
 
/*
 *  TExcelScript()
 */
CLASS TExcelScript
 
  DATA oExcel
  DATA oWorkBooks
  DATA oBook
  DATA oSheet
  DATA oShape
  DATA oCell
  DATA oFind
  DATA cFile
 
  DATA cFont
  DATA nSize
  DATA lBold
  DATA lItalic
  DATA lUnderLine
  DATA nAlign
  DATA lOpen      AS LOGICAL    INIT .F.
  DATA lDefault   AS LOGICAL    INIT .T.
 
  DATA aExcelCols AS ARRAY INIT {}
  DATA aData      AS ARRAY INIT {}
  DATA cAlias
  DATA nAt
  DATA nFormat
  DATA lExcel
  DATA oClip
  DATA aSheets
  DATA nSheets
  DATA nBooks
  DATA aBooks
 
 
  METHOD New()
  METHOD Open( cFilexls )
  METHOD Create( cFilexls )
  METHOD Get( nRow , nCol ,cValue )
  METHOD Say( nRow, nCol, xValue, cFont, nSize, lBold, lItalic, ;
              lUnderLine, nAlign, nColor, nFondo , nBorder )
 
  METHOD CellFormat( nRow, nCol, nBackGround, nLine, cFormat )
  METHOD Borders( cRange, nRow, nCol, nStyle )
  METHOD GetCell()          INLINE (::oCell := ::oExcel:Get( "ActiveCell" ), ::oCell)
  METHOD Visualizar(lValue) INLINE ::oExcel:Visible := lValue
  METHOD nRows INLINE   :: oExcel : oSheet : UsedRange : Rows : Count()
  METHOD nCols INLINE   :: oExcel : oSheet : UsedRange : Columns : Count()
 
 
 
  METHOD AutoFit( nCol )    INLINE ::oSheet:Columns( nCol ):AutoFit()
  METHOD Save()             INLINE IIF( ::lOpen , ::oBook:Save(), ::oBook:SaveAs( ::cFile , ::nFormat ) )
  METHOD SaveAs( cFilexls , nFormat ) INLINE ::oBook:SaveAs( cFilexls , nFormat )
 
  METHOD Print()
  METHOD SetFont(cFont)     INLINE ::oSheet:Cells:Font:Name := cFont
  METHOD SizeFont(nSize)    INLINE ::oSheet:Cells:Font:Size := 12
  METHOD Font(cFont)        INLINE ::cFont := cFont
  METHOD Size(nSize)        INLINE ::nSize := nSize
  METHOD Align(nPos)        INLINE ::nAlign := nPos
  METHOD AddCol( bAction , nAlign , bClrText , bClrPane , bHeading , bFooting )
  METHOD Browse( nRow , nCol , cAlias , cFont , nSize , bClrText , bClrPane  )
  METHOD SetArray(aArray)   INLINE ::aData := aArray
 
  METHOD Headers( nOpc , cVal )
  METHOD Footers( nOpc , cVal )
  METHOD Margins( nOpc , nVal )
  METHOD SetPrintArea(cRange)     INLINE ::oSheet:PageSetup:Set( "printarea"  , cRange )
  METHOD lCenterH( lCenter)       INLINE ::oSheet:PageSetup:Set( "CenterHorizontally" , lCenter )
  METHOD lCenterV( lCenter)       INLINE ::oSheet:PageSetup:Set( "CenterVertically" , lCenter )
  METHOD Zoom( nZoom )            INLINE ::oSheet:PageSetup:Set( "Zoom" , nZoom )
  METHOD SetPage( nPage  )        INLINE ::oSheet:PageSetup:Set( "PaperSize" , nPage )
 
  /*
   * Metodos para las propiedades de la hoja
   */
  METHOD AddSheet()         INLINE ::oExcel:Sheets:Add()
  METHOD CopySheet()        INLINE ::oExcel:Sheets:Copy()
  METHOD DelSheet(cSheet)   INLINE ::oExcel:Sheets(cSheet):Delete()
 
  // cPos -> "After" | "Before"
  METHOD MoveSheet(cSheet,cPos,nSheet)  INLINE ::oExcel:Sheets(cSheet):Move(cPos,nSheet)
*   oSheet := oExcel:Sheets(“oSheet1â€)                              //move sheet position. This example will move
*   oExcel:Sheets( "oSheet2†):Move( oSheet )
 
  METHOD SetSheet(cSheet)               INLINE ::oExcel:Sheets(cSheet):Select() , ::oSheet := ::oExcel:Get( "ActiveSheet" )
  METHOD NameSheet(cSheet,cName)        INLINE ::oExcel:Sheets(cSheet):Name := cName
  METHOD MultiLine(nRow , nCol )        INLINE ::oSheet:Cells( nRow, nCol ):Set("WrapText",.T.)
  METHOD RanMultiLine( cRange )         INLINE ::oSheet:Range( cRange ):Set("WrapText",.T.)
  METHOD AddComent( nRow, nCol, cText )
  METHOD Combinar( cRange )             INLINE ::oSheet:Range( cRange ):Merge()
  METHOD RangeFondo( cRange, nColor )
  METHOD ColumnWidth( nCol, nWidth )    INLINE ::oSheet:Columns( nCol ):Set("ColumnWidth",Alltrim(Str(nWidth)))
*  METHOD ColFormat( nCol , cFormat )    INLINE ::oSheet:Columns( nCol ):Set("NumberFormat, cFormat )
*   ::oSheet:Cells( nRow, nCol ):Set("HorizontalAlignment",Alltrim(Str(nAlign)))
*::oSheet:Columns( nCol )::Set("HorizontalAlignment", -4131 )
 
  METHOD Subtotal(cRange, nGroup, nOpe, nCol)
  METHOD AutoFilter(cRange, nCol, uVal) INLINE ::oSheet:Range( cRange ):AutoFilter(nCol,uVal)
  METHOD End( lClose )
  METHOD ReadOnly( lMsg )
 
 
  // ***** Agregados[AD2K] *******
  MESSAGE Eval()               METHOD eEval( cCommand, lOemAnsi )
 
  METHOD SetPos( cRange )     INLINE (::oSheet:Range( cRange ):Select(), ::GetCell())
  METHOD InsertRow( cRange )  INLINE (iif( cRange != NIL, ::SetPos( cRange ),), ::GetCell():EntireRow():Insert())
  METHOD InsertCol( cRange )  INLINE (iif( cRange != NIL, ::SetPos( cRange ),), ::GetCell():Get("EntireColumn"):Insert())
 
  METHOD Find( cSearch, lMatch, lPart )
  METHOD FindNext()
  METHOD Replace( cSearch, cReplace, lMatch, lPart, lAll, lFull, cFormat )
 
  METHOD Duplicate( cRange )
  MESSAGE Clear()             METHOD eClear( cRange )
  // *****************************
 
  METHOD Chart( cRange , cTitle , nType ) //  [RimUs]
 
  // ****** Agregados [CSR] ******
  METHOD Picture( cFile, cRange )  INLINE (iif( cRange != NIL, ::SetPos(cRange ),), ::oSheet:Pictures:insert(cFile) )
  METHOD SetLandScape()      INLINE ::oSheet:PageSetup:Set("Orientation",2 )
  METHOD SetPortrait()       INLINE ::oSheet:PageSetup:Set("Orientation",1 )
  METHOD Copy( cRange )
  METHOD Paste()
  // *****************************
 
  // ****** Agregados [salo] ******
  METHOD nRowsCount() INLINE ::oSheet:UsedRange:Rows:Count()
  METHOD nColsCount() INLINE ::oSheet:UsedRange:Columns:Count()
 
  // ****** Agregados [Daniel] *****
  METHOD TitleRows(cRange) INLINE (iif(cRange!=NIL,::oSheet:PageSetup:Set("PrintTitleRows",cRange), Nil))
 
 
  METHOD SendMail( cMail , cSubject , lReturn )    // [ Vikthor ]
  METHOD MailSystem()                              // [ Vikthor ]
  METHOD WebPagePreview() INLINE ::oBook:Invoke("WebPagePreview") // [ Vikthor ]
  METHOD AddPicture( cFile, nRow , nCol ) // [ Vikthor ]
  METHOD AddShape( nShape, nLeft , nTop , nWidth , nHeight ) INLINE ::oShape:AddShape( nShape , nLeft , nTop , nWidth , nHeight ) // [ Vikthor ]
  METHOD Dialogs( nTypeDlg ) INLINE ::oExcel:Dialogs(nTypeDlg):Show() // [ Vikthor ]
  METHOD SendeMail( cSender, cSubject, lShowMessage, lIncludeAttachment) // [ Vikthor ]
  METHOD ProtectBook( cPassword )    // [ Vikthor ]
  METHOD ProtectSheet( cPassword )   // [ Vikthor ]
  METHOD UnProtectBook( cPassword )  INLINE ::oBook:Invoke( 'UnProtect' , cPassword  ) // [ Vikthor ]
  METHOD UnProtectSheet( cPassword ) INLINE ::oSheet:Invoke( 'UnProtect' , cPassword  ) // [ Vikthor ]
  METHOD Protect( cPassword )        INLINE ::ProtectBook( cPassword ) , ::ProtectSheet( cPassword ) // [ Vikthor ]
  METHOD UnProtect( cPassword )      INLINE ::UnProtectBook( cPassword ) , ::UnProtectSheet( cPassword ) // [ Vikthor ]
 
  METHOD FormatRange( cRange , aFormat )
  METHOD CountSheets()               INLINE ::nSheets := ::oExcel:Sheets:Count()      // [ Vikthor ]
  METHOD SeekSheet( cSheet )                                                          // [ Vikthor ]
  METHOD HowSheet()                                                                   // [ Vikthor ]
 
  METHOD HPageBreaks( oCell )    INLINE ::oSheet:HPageBreaks:Invoke("Add", oCell )    // [ Vikthor ]
  METHOD Formula( nRow , nCol , cValue )                                              // [ Vikthor ]
  ERROR HANDLER ERROR()
 
  METHOD nBooks()                   INLINE ::nBooks := ::oBook:Count()                // [ Vikthor ]
  METHOD SeekBook( cBook )                                                            // [ Vikthor ]
  METHOD HowBook()                                                                    // [ Vikthor ]
 
ENDCLASS
 
 *  TExcelScript():New()
METHOD New() CLASS TExcelScript
  ::lExcel  := .T.   // acrescentei
  ::oExcel := TOleAuto():New("Excel.Application")
  ::aExcelCols := {}
RETURN Self
 
/*
Eu tirei pois funciona somente com xharbour
METHOD NEW()  CLASS TExcelScript
      ::lExcel  := .T.
      TRY
        ::oExcel := GetActiveObject( "Excel.Application" )
        ::oClip:=TClipBoard():New()
        ::oClip:Clear()
      CATCH
         TRY
            ::oExcel := CreateObject( "Excel.Application" )
            ::oClip:=TClipBoard():New()
            ::oClip:Clear()
         CATCH
            Alert( "No está Excel Instalado en está Pc." )
            ::lExcel  := .F.
         END
      END
      ::aExcelCols := {}
RETURN( Self )
*/
 
/*
 *  TExcelScript():Open()
 */
METHOD Open( cFilexls )  CLASS TExcelScript
  LOCAL lNotify  := .T.
  LOCAL lAddToMRU := .T.
  ::cFile := cFilexls
  *::oWorkBooks:=::oExcel:Get( "WorkBooks")
  *::oWorkBooks:Open( ::cFile ) //, , , , , , , , , , lNotify, , lAddToMRU)
 
  ::oExcel:WorkBooks:Open( ::cFile ) // , , , , , , , , , , lNotify, , lAddToMRU)
 
  //Open(FileName, UpdateLinks, ReadOnly, Format, Password, WriteResPassword, IgnoreReadOnlyRecommended, Origin, Delimiter, Editable, Notify, Converter, AddToMRU)
  ::oBook       := ::oExcel:Get( "ActiveWorkBook")
  ::oSheet      := ::oExcel:Get( "ActiveSheet" )
  ::oShape      := ::oSheet:Get( "Shapes" )
  ::cFont       := "Arial"
  ::nSize       := 10
  ::lBold       := .F.
  ::lItalic     := .F.
  ::lUnderLine  := .F.
  ::nAlign      := 1
  ::lDefault    := .F.
  ::lOpen       := .T.
  ::nFormat     :=   ::oBook:Get("FileFormat")
 
  ::SetPos("A1")
  ::GetCell()
 
RETURN Self
 
 
METHOD ReadOnly(lMsg)  CLASS TExcelScript
lVret := .F.
IF ::oBook:ReadOnly
   lVret := .T.
   IF lMsg
      MsgInfo(" El archivo " +::cFile + " está abierto en otra sesión" )
   ENDIF
ENDIF
RETURN( lVret )
/*
 *  TExcelScript():Create()
 */
METHOD Create( cFilexls )  CLASS TExcelScript
 
  ::cFile := cFilexls
 
  //::oWorkBooks:=::oExcel:Get( "WorkBooks")
 
  ::oExcel:WorkBooks:Add()
 
  ::oBook       := ::oExcel:Get( "ActiveWorkBook")
  ::oSheet      := ::oExcel:Get( "ActiveSheet" )
  ::oShape      := ::oSheet:Get( "Shapes" )
  ::cFont       := "Arial"
  ::nSize       := 10
  ::lBold       := .F.
  ::lItalic     := .F.
  ::lUnderLine  := .F.
  ::nAlign      := 1
  ::lDefault    := .T.
  ::nFormat     :=   ::oBook:Get("FileFormat")
 
/*
  oCheck := ::oExcel:Get("ErrorCheckingOptions")
  ?oCheck:EvaluateToError
  oCheck:EvaluateToError:= .T.
  ?oCheck:EvaluateToError
  ?oCheck:InconsistentFormula
  ?oCheck:OmittedCells
  ?oCheck:BackgroundChecking
*/
 
  ::SetPos("A1")
  ::GetCell()
 
RETURN Self
 
METHOD Get( nRow , nCol , cValue )  CLASS TExcelScript
       LOCAL xVret
       LOCAL cType
       DEFAULT cValue := "C"
       xVret := ::oSheet:Cells( nRow, nCol ):Value
       xVret := IIF( ValType( xVret )=="U", "" , xVret )
       cType := ValType( xVret )
       // 999,999,999,999,999,999.99
       IF cValue != Nil
          IF cValue == "N"
             xVret := IIF( ValType( xVret )=="C",Val(xVret) ,;
                      IIF( ValType( xVret )=="D",xVret , Val( Str(xVret, 21, NumGetDecimals(xVret) ) ) ) )
          ENDIF
          IF cValue == "C"
*             xVret := IIF( ValType( xVret )=="N",Ltrim(Str(xVret) ),;
             xVret := IIF( ValType( xVret )=="N",Str(xVret, 21, NumGetDecimals(xVret)),;
                      IIF( ValType( xVret )=="D",Dtos(xVret) ,xVret )  )
          ENDIF
 
 
 
 
       ENDIF
RETURN( xVret )
 
/*
 *  TExcelScript():RangeFondo()
 */
METHOD RangeFondo( cRange , nColor )  CLASS TExcelScript
 
  DEFAULT nColor := Rgb(255 , 255 , 255 )
 
  ::oSheet:Range( cRange ):Interior:Color := nColor
 
RETURN Self
 
/*
 *  TExcelScript():Borders()
 */
METHOD Borders( cRange , nRow , nCol , nStyle )  CLASS TExcelScript
 
  if Empty( cRange )
    ::oSheet:Cells( nRow, nCol ):Borders():LineStyle  := nStyle
  else
    ::oSheet:Range( cRange ):Borders():LineStyle  := nStyle
  endif
 
RETURN Self
 
/*
 *  TExcelScript():CellFormat()
 */
METHOD CellFormat( nRow, nCol, nColor, nLine, cFormat )  CLASS TExcelScript
 
  if nRow == NIL .or. nCol == NIL
    ::GetCell()
    DEFAULT nRow  := ::oCell:Row
    DEFAULT nCol  := ::oCell:Column
  endif
 
  if ::lDefault
    DEFAULT nColor := Rgb(255 , 255 , 255 )
  endif
 
  if nColor != NIL
    ::oSheet:Cells( nRow, nCol ):Interior:Color := nColor
  endif
 
  if cFormat != NIL
    ::oSheet:Cells( nRow, nCol ):Set("NumberFormat",cFormat)
  endif
  //::oSheet:Cells( nRow, nCol ):Set("Text",cFormat)
 
  //::oSheet:Cells( nRow, nCol ):Interior:Pattern := 2
  //::oSheet:Cells( nRow, nCol ):Borders(nLine):LineStyle  := 1  // Bottom
 
RETURN Self
 
/*
 *  TExcelScript():AddComent()
 */
METHOD AddComent( nRow , nCol , cText )  CLASS TExcelScript
 
  DEFAULT cText := ""
 
  IF !Empty( cText )
    ::oSheet:Cells( nRow, nCol ):AddComment(cText)
  ENDIF
 
RETURN Self
 
/*
 *  TExcelScript():Print()
 */
METHOD Print()   CLASS TExcelScript
 
  ::oSheet:PrintOut()
 
RETURN Self
 
/*
 *  TExcelScript():Say()
 */
METHOD Say( nRow, nCol, xValue, cFont, nSize, lBold, lItalic, ;
            lUnderLine, nAlign, nColor, nFondo , nOrien , nStyle , cFormat )  CLASS TExcelScript
  * nAlign -> 1  // Derecha
  * nAlign -> 4  // Izquierda
  * nAlign -> 7  // Centrado
 
  local xVret
 
  if ::lDefault
    DEFAULT cFont       := ::cFont
    DEFAULT nSize       := ::nSize
    DEFAULT lBold       := ::lBold
    DEFAULT lItalic     := ::lItalic
    DEFAULT lUnderLine  := ::lUnderLine
    DEFAULT nAlign      := ::nAlign
    DEFAULT nColor      := Rgb( 0 , 0 , 0)
    DEFAULT nFondo      := RGB( 255, 255, 255 )
    DEFAULT nOrien      := 0
    DEFAULT nStyle      := 1
    DEFAULT cFormat     := "0"
 
  endif
 
  if nRow == NIL .or. nCol == NIL
    ::GetCell()
    DEFAULT nRow  := ::oCell:Row
    DEFAULT nCol  := ::oCell:Column
  endif
 
  if cFont != NIL
    ::oSheet:Cells( nRow, nCol ):Font:Name := cFont
  endif
 
  if nSize != NIL
     ::oSheet:Cells( nRow, nCol ):Font:Size := nSize
  endif
 
  if lBold != NIL
    ::oSheet:Cells( nRow, nCol ):Font:Bold := lBold
  endif
 
  if lItalic != NIL
    ::oSheet:Cells( nRow, nCol ):Font:Italic := lItalic
  endif
 
  if lUnderLine != NIL
     ::oSheet:Cells( nRow, nCol ):Font:UnderLine := lUnderLine
  endif
 
  if nColor != NIL
    ::oSheet:Cells( nRow, nCol ):Font:Color := nColor
  endif
 
  IF ValType( xValue ) == "N"
     ::oSheet:Cells( nRow, nCol ):Set("NumberFormat",cFormat)
  ENDIF
  ::oSheet:Cells( nRow, nCol ):Value := xValue
 
  if nFondo != NIL
    ::oSheet:Cells( nRow, nCol ):Interior:Color := nFondo
  endif
 
  if nAlign != NIL 
     ::oSheet:Cells( nRow, nCol ):Set("HorizontalAlignment",Alltrim(Str(nAlign)))
     ::oSheet:Cells( nRow, nCol ):Set("Orientation",nOrien)
  endif
 
  if nStyle != NIL
     ::oSheet:Cells( nRow, nCol ):Borders():LineStyle  := nStyle
  ENDIF
RETURN Self
 
/*
 *  TExcelScript():End()
 */
METHOD End( lClose ) CLASS TExcelScript
  DEFAULT lClose  := .T.
  IF !lClose
    ::oExcel:WorkBooks:Close()
  ELSE
    ::oExcel:Quit()
  ENDIF
 
//  ::oClip:End() //para efeitos do clipper
 
RETURN NIL
 
/*
  if ValType(::oFind) == "O"
    ::oFind:End() ; ::oFind   := NIL
  endif
 
  if ValType(::oCell) == "O"
    ::oCell:End() ; ::oCell   := NIL
  endif
 
  if ValType(::oSheet) == "O"
    ::oSheet:End(); ::oSheet  := NIL
  endif
 
  if ValType(::oBook) == "O"
    ::oBook:End() ; ::oBook   := NIL
  endif
 
  ::oExcel:Quit()  ; ::oExcel  := NIL
*/
RETURN NIL
 
/*
 *  TExcelScript():Eval()
 */
METHOD eEval( cCommand, lOemAnsi, xParam ) CLASS TExcelScript   // [AD2K]
 
  DEFAULT lOemAnsi  := .F.
 
  if lOemAnsi
     cCommand  := OemToAnsi( cCommand )
  endif
 
  // Soporte de lineas de Comentarios
  if Left( AllTrim( cCommand ), 1 ) $ "*/#"             // No procesar linea de comentario
 
  elseif Left( AllTrim( cCommand ), 1 ) == "!"          // Ejecutar Funcion Clipper/FW
    cCommand  := AllTrim(SubStr( cCommand, 2 ))
    Eval( &("{|oThis, uParam| " + cCommand + " }" ), Self, xParam )
 
  else                                                  // Ejecuta Metodo TExcelScript
    // Ahora sin uso de privadas [LKM]
    Eval( &("{|oThis, uParam| oThis:" + cCommand + " }" ), Self, xParam )
 
  endif
 
RETURN Self
 
/*
 *  TExcelScript():SubTotal()
 */
METHOD SubTotal( cRange, nGroup, nOpe, nCol  ) CLASS TExcelScript
 
  DEFAULT nOpe := 1
 
  DO CASE
  CASE nOpe == 1
    nOpe := -4157   // Sum
  CASE nOpe == 2
    nOpe := -4106   // Ave
  CASE nOpe == 3
    nOpe := -4112   // Count
  CASE nOpe == 4
    nOpe := -4155   // StDev
   CASE nOpe == 5
    nOpe := -4156   // StDevP
  OTHERWISE
    nOpe := -4157   // Sum
  ENDCASE
 
  ::oSheet:Range( cRange ):SubTotal( nGroup, nOpe, nCol  )
 
RETURN Self
 
/*
 *  TExcelScript():Duplicate()
 */
METHOD Duplicate( cRange ) CLASS TExcelScript   // [AD2K]
 
  DEFAULT cRange  := ::oCell:Row
 
  ::oExcel:Rows( cRange ):Select()
  ::oExcel:Selection:Copy()
  ::oExcel:Selection:Insert()
 
RETURN Self
 
/*
 *  TExcelScript():Clear()
 */
METHOD eClear( cRange ) CLASS TExcelScript  // [AD2K]
 
  ::oExcel:Range( cRange ):Select()
  ::oExcel:Selection:Invoke("ClearContents")
 
RETURN Self
 
/*
 *  TExcelScript():Find()
 */
METHOD Find( cSearch, lMatch, lPart ) CLASS TExcelScript    // [AD2K]
 
  local oRange, lFound := .F.
 
  if cSearch == NIL
    RETURN lFound
  endif
 
  DEFAULT lMatch  := .F.  ,;
          lPart   := .F.
 
  ::GetCell():Activate()
  oRange := ::oSheet:Cells:Find( cSearch )
 
  if ValType( oRange ) == "O" .and. oRange[1] > 0
    oRange:Activate()
 
    ::GetCell()
    ::oFind   := oRange
    lFound    := .T.
 
    if (lMatch) .or. !(lPart)
      while !iif( lPart, cSearch $ ::Get( ::oCell:Row, ::oCell:Column ),  ;
                         cSearch == ::Get( ::oCell:Row, ::oCell:Column ))
        if !(::FindNext( oRange ))
          lFound  := .F.
          exit
        endif
      enddo
    endif
  endif
 
  RELEASE oRange
 
RETURN lFound
 
/*
 *  TExcelScript():FindNext()
 */
METHOD FindNext() CLASS TExcelScript    // [AD2K]
 
  local lFound := .F.
  local oRange, cRange, oCell
 
  if ValType( ::oFind ) == "O"
    oCell   := ::oCell
    cRange  := ::oExcel:Get( "ActiveCell" ):Address
    oRange  := ::oExcel:Cells:FindNext( ::oFind )
 
    if ValType( oRange ) == "O" .and. oRange[1] > 0
      oRange:Activate()
      ::GetCell()
 
      if ::oCell:Row == oCell:Row
        lFound  := ::oCell:Column > oCell:Column
      elseif ::oCell:Row > oCell:Row
        lFound  := .T.
      endif
 
      if lFound
        ::oFind := oRange
      else
        ::SetPos( cRange )
        ::oFind := NIL
      endif
    endif
  endif
 
RETURN lFound
 
/*
 *  TExcelScript():Replace()
 */
METHOD Replace( cSearch, cReplace, lMatch, lPart, lAll, lFull, cFormat ) CLASS TExcelScript    // [AD2K]
 
  local lFound  := .F.
 
  DEFAULT lAll  := .F.
  DEFAULT lFull := .F.
 
  if cReplace != NIL
    while ::Find( cSearch, lMatch, lPart )
      lFound := .T.
 
      if cFormat != NIL
        ::CellFormat( ,,,, cFormat )
      endif
 
      if (lFull)
        ::Say(,, cReplace )
      else
        ::Say(,, StrTran(::Get(), cSearch, cReplace ) )
      endif
 
      if !(lAll)
        exit
      endif
    enddo
  endif
 
RETURN lFound
 
/*
 *  TExcelScript():Chart()
 */
METHOD Chart( cRange , cTitle , nType , nDepth , nGapDepth ) CLASS TExcelScript    // [RimUs]
   LOCAL oChart , oSheet
   DEFAULT cTitle := "Grafica"
   DEFAULT nDepth := 20     // Profundidad de la Grafica
   DEFAULT nGapDepth := 20     // Separacion entre series
   ::oSheet:Range( cRange ):Select()
   ::oExcel:Charts:Add()
   oChart := ::oExcel:Get( "ActiveChart" )
   oChart:ChartType := nType
   oChart:HasTitle := .T.
   oChart:ChartTitle:Text := cTitle
   oChart:Set("DepthPercent" , nDepth)
   oChart:Set("GapDepth" , nGapDepth)
RETURN Self
 
 
/*
 *  TExcelScript():aAddCol()
 */
METHOD AddCol(  bAction , nAlign ,  bClrText , bClrPane , bHeading , bFooting ) CLASS TExcelScript    // [ Vikthor ]
   DEFAULT nAlign := 1  // Derecha
   DEFAULT bAction    := {|| ""}
   DEFAULT bClrText  := {||Rgb( 0,0,0)}
   DEFAULT bClrPane  := {||Rgb( 255,255,255)}
   DEFAULT bHeading  := {|| "" }
   DEFAULT bFooting  := {|| "" }
 
   aadd( ::aExcelCols , { bAction , nAlign , bClrText , bClrPane , bHeading , bFooting  } )
 
RETURN Self
 
/*
 *  TExcelScript():Browse()
*/
 
METHOD Browse( nRow , nCol , cAlias , cFont , nSize , bClrText , bClrPane ) CLASS TExcelScript    // [ Vikthor ]
   LOCAL nCiclo
   LOCAL nI
 
   ::nAt := 0
   DEFAULT cFont := "Tahoma"
   DEFAULT nSize := 10
   DEFAULT bClrText := {|| Rgb( 0 , 0 , 0)}
   DEFAULT bClrPane := {|| Rgb( 255 , 255 , 255 )}
   DEFAULT nRow := 1
   DEFAULT nCol := 1
   nCol--
   ::cAlias := cAlias
 
   IF !Empty( ::cAlias )
     /* encabezados */
     FOR nCiclo := 1 TO LEN( ::aExcelCols )
       ::Say( nRow , nCol + nCiclo, Eval( ::aExcelCols[nCiclo, 5 ] ), cFont, nSize,,,, ::aExcelCols[nCiclo, 2 ], ;
              Eval(  bClrText  ), Eval(  bClrPane  ) )
       ::Borders( , nRow , nCol+nCiclo , 1 )
     NEXT
     nRow ++
     /* arreglo o DBF */
     IF Lower(::cAlias) == "array"
        (::cAlias)->( DbGoTop() )
        FOR nI := 1 TO LEN( ::aData )
           FOR nCiclo := 1 TO LEN(::aExcelCols)
            ::Say( nRow , nCol+nCiclo, ::aData[nI,nCiclo], cFont, nSize,,,, ::aExcelCols[nCiclo, 2 ], ;
                  Eval(  ::aExcelCols[nCiclo, 3 ]  ), Eval(  ::aExcelCols[nCiclo, 4 ]  ) )
            ::Borders( , nRow , nCol+nCiclo , 1 )
           NEXT
           ::nAt++
           nRow++
        NEXT
     ELSE
        DO WHILE !(::cAlias)->(EOF())
           FOR nCiclo := 1 TO LEN(::aExcelCols)
              ::Say( nRow , nCol+nCiclo, Eval( ::aExcelCols[nCiclo, 1 ] ), cFont, nSize,,,, ::aExcelCols[nCiclo, 2 ], ;
                      Eval( ::aExcelCols[nCiclo, 3 ] ), Eval( ::aExcelCols[nCiclo, 4 ] ))
              ::Borders( , nRow , nCol+nCiclo , 1 )
           NEXT
           ::nAt++
           nRow++
           (::cAlias)->(DbSkip(1))
        ENDDO
     ENDIF
     /* Footers */
     FOR nCiclo := 1 TO LEN(::aExcelCols)
       ::Say( nRow , nCol+nCiclo, Eval( ::aExcelCols[nCiclo, 6 ] ), cFont, nSize,,,, ::aExcelCols[nCiclo, 2 ] ,;
              Eval(  bClrText  ), Eval(  bClrPane  ) )
       ::Borders( , nRow , nCol+nCiclo , 1 )
     NEXT
     FOR nCiclo := 1 TO LEN(::aExcelCols)
       ::AutoFit( nCol+nCiclo )
     NEXT
  ENDIF
 
RETURN Self
 
 
/*
 *  Margins( nOpc , cVal )
 */
METHOD Margins( nOpc , nVal )  CLASS TExcelScript    // [ Vikthor ]
DEFAULT nVal := 0
DEFAULT nOpc := 0
DO CASE
   CASE nOpc == 0  // Todos
        ::oSheet:PageSetup:Set( "RightMargin"  , nVal )
        ::oSheet:PageSetup:Set( "TopMargin"    , nVal )
        ::oSheet:PageSetup:Set( "LeftMargin"   , nVal )
        ::oSheet:PageSetup:Set( "BottomMargin" , nVal )
        ::oSheet:PageSetup:Set( "FooterMargin" , nVal )
        ::oSheet:PageSetup:Set( "HeaderMargin" , nVal )
   CASE nOpc == 1  // Right
        ::oSheet:PageSetup:Set( "RightMargin" , nVal )
   CASE nOpc == 2  // Top
        ::oSheet:PageSetup:Set( "TopMargin" , nVal )
   CASE nOpc == 3  // Left
        ::oSheet:PageSetup:Set( "LeftMargin" , nVal )
   CASE nOpc == 4  // Bottom
        ::oSheet:PageSetup:Set( "BottomMargin" , nVal )
   CASE nOpc == 5  // Footer Margin
        ::oSheet:PageSetup:Set( "FooterMargin" , nVal )
   CASE nOpc == 6  // Header Margin
        ::oSheet:PageSetup:Set( "HeaderMargin" , nVal )
ENDCASE
RETURN self
 
 
/*
 *  Footers( nOpc , cVal )
 */
METHOD Footers( nOpc , cVal )  CLASS TExcelScript    // [ Vikthor ]
DEFAULT cVal := 1  // Centrado
DEFAULT nOpc := 0
DO CASE
   CASE nOpc == 1  // Center
        ::oSheet:PageSetup:Set( "CenterFooter" , cVal )
   CASE nOpc == 2  // Left
        ::oSheet:PageSetup:Set( "LeftFooter" , cVal )
   CASE nOpc == 3  // Right
        ::oSheet:PageSetup:Set( "RightFooter" , cVal )
ENDCASE
RETURN self
 
/*
 *  Headers( nOpc , cVal )
 */
METHOD Headers( nOpc , cVal )  CLASS TExcelScript    // [ Vikthor ]
DEFAULT cVal := 1  // Centrado
DEFAULT nOpc := 0
DO CASE
   CASE nOpc == 1  // Center
        ::oSheet:PageSetup:Set( "CenterHeader" , cVal )
   CASE nOpc == 2  // Left
        ::oSheet:PageSetup:Set( "LeftHeader" , cVal )
   CASE nOpc == 3  // Right
        ::oSheet:PageSetup:Set( "RightHeader" , cVal )
ENDCASE
RETURN Self
 
METHOD SendMail( cMail, cSubject, lReturn ) CLASS TExcelScript    // [ Vikthor ]
   DEFAULT cMail := "Vikthor@creswin.com" ,;
           cSubject := "TExcel Mailer Class" ,;
          lReturn := .T.
 
    ::oBook:SendMail( cMail , cSubject , lReturn )
 
RETURN Self
 
METHOD MailSystem() CLASS TExcelScript    // [ Vikthor ]
   nVret := ::oExcel:MailSystem()
/*
   DO CASE
    CASE nVret == 1  // xlMAPI
        MsgInfo( "Mail system is Microsoft Mail" )
    CASE nVret == 0  // xlPowerTalk
        MsgInfo( "Mail system is PowerTalk" )
    CASE nVret == 2  // xlNoMailSystem
        MsgInfo( "No mail system installed" )
   ENDCASE
*/
RETURN( nVret )
 
/*
 *  AddPicture( cFile, nRow , nCol , nWidth , nHeight)
 */
METHOD AddPicture( cFile, nRow , nCol , nWidth , nHeight ) CLASS TExcelScript    // [ Vikthor ]
  IF Empty( cFile )
     RETURN ( Nil  )
  ENDIF
  DEFAULT nRow := 1 ,;
          nCol := 1 ,;
          nWidth := 100 ,;
          nHeight := 100
  ::oShape:Invoke("AddPicture" , cFile , .T. , .T. , nRow , nCol , nWidth , nHeight )
RETURN( Nil )
 
/*
 *  TExcelScript():SendeMail()
 */
METHOD SendeMail( cSender, cSubject, lShowMessage, lIncludeAttachment) CLASS TExcelScript    // [ Vikthor ]
  IF Empty( cSender )
     RETURN ( Nil  )
  ENDIF
   DEFAULT cSender := "vikthor@creswin.com" ,;
           cSubject := "TExcel Mailer Class" ,;
           lShowMessage := .F. ,;
           lIncludeAttachment := .F.
  ::oBook:Invoke("SendForReview" , cSender , cSubject, lShowMessage, lIncludeAttachment )
RETURN( Nil )
 
/*
 *  TExcelScript():ProtectBook()
 */
METHOD ProtectBook( cPassword ) CLASS TExcelScript    // [ Vikthor ]
    ::oBook:Invoke( 'Protect' , cPassword , .T. , .T. )
RETURN( Nil )
 
/*
 *  TExcelScript():ProtectSheet()
 */
METHOD ProtectSheet( cPassword ) CLASS TExcelScript    // [ Vikthor ]
    ::oSheet:Invoke( 'Protect' , cPassword , .T. , .T. , .T. , .T. )
RETURN( Nil )
 
/*
 *  TExcelScript():Copy()
 */
METHOD Copy( cRange ) CLASS TExcelScript  // [CSR]
 
  If cRange == NIL
     RETURN Self
  End
 
  ::oExcel:Range( cRange ):Select()
  ::oExcel:Selection:Copy()
 
RETURN Self
 
/*
 *  TExcelScript():Paste()
 */
METHOD Paste() CLASS TExcelScript // [CSR]
 
  ::oSheet:Paste()
 
RETURN Self
 
/*
 *  TExcelScript():FormatRange()
*/
 
METHOD FormatRange( cRange , cFont , nSize , lBold , lItalic , nAlign , nFore , nBack , nStyle , cFormat , lAutoFit )
  LOCAL oRange
 
  oRange := ::oSheet:Range( cRange )
 
  IIF( cFont == Nil  , , oRange:Font:Name := cFont )
  IIF( nSize == Nil  , , oRange:Font:Size := nSize )
  IIF( lBold == Nil  , , oRange:Font:Bold := lBold )
  IIF( lItalic == Nil, , oRange:Font:Italic := lItalic )
  IIF( nFore == Nil  , , oRange:Font:Color := nFore )
  IIF( nBack == Nil  , , oRange:Interior:Color := nBack )
  IIF( cFormat == Nil, , oRange:Set("NumberFormat",cFormat) )
  IIF( nStyle == Nil , , oRange:Borders():LineStyle  := nStyle )
  IIF( nAlign == Nil , , oRange:Set("HorizontalAlignment",Alltrim(Str(nAlign))) )
  IIF( lAutoFit == Nil , , oRange:Columns:AutoFit() )
 
RETURN ( Nil )
/*
 *  TExcelScript():SeekSheet()
*/
 
METHOD SeekSheet( cSheet )
    LOCAL lVret := .F.
    ::HowSheet()
    IIF( Ascan( ::aSheet , cSheet ) > 0 , .T.  ,  .F. )
RETURN ( lVret )
 
/*
 *  TExcelScript():HowSheet()
*/
 
METHOD HowSheet()
    LOCAL nSheets := ::oExcel:Sheets:Count()
    LOCAL i
    ::aSheets := {}
    FOR i := 1 TO nSheets
         aadd( ::aSheets , ::oExcel:Sheets:Item( i ):Name )
    NEXT
RETURN ( Nil )
 
/*
 *  cMakeRange()
 */
FUNCTION cMakeRange( nRowIni, nColIni, nRowFin, nColFin )
 
  local cRange := cColumn2Letter(nColIni) + AllTrim(Str(Int(nRowIni)))
 
  if nRowFin != NIL .and. nColFin != NIL
      cRange  += ":" + cColumn2Letter(nColFin) + AllTrim(Str(Int(nRowFin)))
  endif
 
RETURN cRange
 
 
/*
 * cLetter2Column()
 */
FUNCTION cLetter2Column( cLetter )
   local nCol := 0
RETURN Asc(cLetter)-64
 
/*
 *   cColumn2Letter()
 */
FUNCTION cColumn2Letter( n )
 
   local r := ""
 
   if n > 26
      r := Chr( 64 + Int( n / 26 ) )
      n := n % 26
   endif
 
   r += Chr( 64 + n )
 
RETURN r
 
/*
 *  NumGetDecimals( <nNumber> ) --> nDecimals
 */
STATIC FUNCTION NumGetDecimals( nNumber )
 
  LOCAL cNum, nLen
  LOCAL nPos, nDec
 
  cNum := Str( nNumber,21,10)
  nLen := Len( cNum )
  nPos := At( ".", cNum )
 
  IF nPos > 0
    FOR nDec := nLen TO nPos STEP -1
      IF SubStr( cNum, nDec, 1 ) == "0"
        cNum := SubStr( cNum, 1, Len(cNum) - 1 )
      ELSE
        exit
      ENDIF
    NEXT
 
    RETURN( LEN( ALLTRIM( SUBSTR( cNum, nPos + 1 ))))
  ENDIF
 
RETURN ( 0 )
 
 
METHOD ERROR() CLASS TExcelScript
   LOCAL cMsg, nParam
//   nParam := PCount()
//   cMsg   := __GetMessage() //tirei para efeitos do clipper
//   MsgInfo( "La propiedad "+__GetMessage() +" no existe " , "Aviso al usuario") //tirei para efeitos do clipper
RETURN
 
METHOD Formula( nRow , nCol , cValue ) CLASS TExcelScript // [ Vikthor ]
* TRY  //tirado para efeitos do clipper
 // ::oSheet:Cells( nRow , nCol ):Formula:=cValue
    ::oSheet:Cells( nRow , nCol ):FormulaLocal:=cValue
* CATCH  //tirado para efeitos do clipper
*   MsgStop( "La formula no es correcta "+cValue , "Aviso al usuario")  //tirado para efeitos do clipper
* END  //tirado para efeitos do clipper
RETURN( Nil )
 
 
/*
 *  TExcelScript():SeekBook()
*/
 
METHOD SeekBook( cBook )
    LOCAL lVret := .F.
   ::HowBook()
   IIF( Ascan( ::aBook , cBook ) > 0 , .T.  ,  .F. )
RETURN ( lVret )
 
/*
 *  TExcelScript():HowBook()
*/
 
METHOD HowBook()
   LOCAL nBooks := ::nBook()
    LOCAL i
   ::aBook := {}
   FOR i := 1 TO nBook
       aadd( ::aBooks , ::oBook:Item( i ):Name )
    NEXT
RETURN ( Nil )
 
 

 

Link to comment
Share on other sites
Geraldo (gbsilva) Newbie

Geraldo (gbsilva)

Posted
Posted

Olá uso essa função criada criada por uma turma dos feras do nosso fórum e funciona muito bem. Fiz algumas alterações para atender minha necessidade, mas esta documentado.

 

Abaixo um exemplo de utilização:

 

  local i,nDados,cArquivo


  cArquivo:= cGetFile32("*.XLS","Escolha o arquivo")
  IF !File(cArquivo)   
      RETURN
  ENDIF
  lNewFile := cArquivo

  //-> Aqui leio os dados da planilha 
  LeExcel( lNewFile,@aDados, 24, {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24},1,2,,.f. )
  nDados:=Len(aDados)

  For i = 1 to nDados
      ... trato as colunas retornadas e 
      
      exemplo de tratamento
      codigo := aDados[i,1]
  
  
      ... chamo função para gravar
  Next



////////////////////////////DADOS DA FUNCAO////////////////////////////////////////////
// NOME       : LeExcel                                                              //
// AUTOR      : Evandro G. de Paula                                                  //
// COLABORAÇÃO: Gilmer Tavares (toda a parte OLE)                                    //
// SINTESE    : Ler arquivo xml                                                      //
// PARAMETROS : <1> cNome do arquivo xml                                             //
//              <2> Matriz a ser carregado os dados
//              <3> nTotal de colunas a ler (coluna limite a ser lida)               //
//              <4> aVetor com os números da coluna a serem efetivamente lidas       //
//              <5> nColuna verificação do conteúdo obrigatório. Caso a célula esteja//
//		              vazia, toda a linha será ignorada. (default=aVetor[1])          //
//              <6> Linha inicial na planilha a ser lida (padrão 1)
//              <7> Vetor para pegar dados no cabeçalho da planilha lida
//              <8> Array com as posições a serem lidas na planilhas <linha,coluna>
//              <9> .f. padrão lê apenas primeira aba, se for .t. lê todas
// RETORNO    : aVetor com os dados da planilha                                      //
///////////////////////////////////////////////////////////////////////////////////////

/* Chamada LeExcel(Vide Abaixo)
#include "FiveWin.ch"
Function Main()
  LeExcel( 'original', 4, {1,2,3,4},1 ) 
  //-> Uma chamada mais incrementada
  LeExcel( lNewFile,@aDados, 21, {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21},1,2,,.f. )
return nil
*/

Function LeExcel(cXlsArquivo,aVetor,nColunas,aColunas,nColObrig,nLinhaInicial,aTitulos,aColAd,cSheets)
  Local oDlg,oExcel,oFolha,nLinhas
  Local cProject, cFile, cRota:=cFILEPATH(GETMODULEFILENAME(GETINSTANCE()))
  // Tirei as 02 linhas abaixo pois não tem necessidade
  //cXlsArquivo+='.xls'  
  //cXlsArquivo:=strtran( cXlsArquivo, '.xls.xls','.xls' )
  if !file( cXlsArquivo )
		msgalert( 'Arquivo '+cXlsArquivo+' não encontrado.', 'Verifique' )
  else
      oExcel := TOleAuto():New( "Excel.Application" )
      //oExcel:Workbooks:Open(cRota+cXlsArquivo)
      oExcel:Workbooks:Open(cXlsArquivo)
      oFolha := oExcel:Get( "ActiveSheet" )
      oWork :=  oExcel:Get( "ActiveWorkbook" )
      oWork:Saved:=.t.
      nLinhas:=oFolha:UsedRange:Rows:Count()
      oExcel:Workbooks:Close()
      oExcel:Quit()
		LeArqExcel( cXlsArquivo,nColunas, aColunas,@aVetor, nColObrig,nLinhaInicial,aTitulos,aColAd,cSheets )
  endif
return aVetor

Function LeArqExcel( cXlsArquivo, nColunas, aColunas, aVetor, nColObrig, nLinhaInicial,aTitulos,aColAd,cSheets )
  Local aLinha
  Local cNome, cMatricula, cChave, cLinha
  Local nLinhas, x, x1, nPos
  Local oExcel, oFolha, oWork
  Local xLinha,nCol:=1,nDados:=0,nH,nSheets:=0,nF
  Local nT,nP,nColAd,lColAd,nContaAba:=1  //-> geraldo

  DEFAULT nColObrig:=aColunas[1]
  DEFAULT nLinhaInicial := 1
  DEFAULT cSheets := .f.
  
  
  oExcel := TOleAuto():New( "Excel.Application" )
  oExcel:Workbooks:Open(cXlsArquivo)
  //-> Verifica abas
  nSheets := oExcel:Sheets:Count()
  //-> Verifica se vai ler cabeçalho apenas da primeira planilha
  if cSheets = .f.
     nLerAba := 1
  else
     nLerAba := nSheets
  endif	   
  For nF := 1 to nSheets
		oExcel:Worksheets( nF ):Select()
      oFolha := oExcel:Get( "ActiveSheet" )
      oWork :=  oExcel:Get( "ActiveWorkbook" )
      oWork:Saved:=.t.
      **************************************************************************
		//-> Inclui essas linha para pegar cabeçalho (Geraldo 10/11/2009)
      If nContaAba <= nLerAba
		   if !empty(aColAd) 
            nColAd := Len(aColAd)
	         For nT = 1 to nColAd
                aAdd( aTitulos, {oFolha:Cells( aColAd[nT,1],aColAd[nT,2] ):Value } )
            Next
	         /* Como pegar os dados do cabeçalho
			   For nP = 1 to Len(aTitulos)
                ? aTitulos[nP,1] 
            Next
            */
		   endif
		   nContaAba++
		endif
		**************************************************************************
		nLinhas=oFolha:UsedRange:Rows:Count()
      For x:= nLinhaInicial to nLinhas
          xLinha:=oFolha:Cells( x, nColObrig ):Value
          if nColObrig > 0 .and. xLinha == nil
             loop
          endif
          aLinha:={}
          For x1 = 1 to nColunas
              if ascan( aColunas, x1 )>0
                 aadd( aLinha, oFolha:Cells( x, x1 ):Value )
              endif
          Next x1
          aAdd( aVetor, aLinha )
      Next x
  Next
  oExcel:Workbooks:Close()
  oExcel:Quit()
return aVetor

Sds,

Link to comment
Share on other sites
  • 2 years later...
kapiaba Enthusiast

kapiaba

Posted
Posted

Olá uso essa função criada criada por uma turma dos feras do nosso fórum e funciona muito bem. Fiz algumas alterações para atender minha necessidade, mas esta documentado.

Abaixo um exemplo de utilização:

  local i,nDados,cArquivo


  cArquivo:= cGetFile32("*.XLS","Escolha o arquivo")
  IF !File(cArquivo)   
      RETURN
  ENDIF
  lNewFile := cArquivo

  //-> Aqui leio os dados da planilha 
  LeExcel( lNewFile,@aDados, 24, {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24},1,2,,.f. )
  nDados:=Len(aDados)

  For i = 1 to nDados
      ... trato as colunas retornadas e 
      
      exemplo de tratamento
      codigo := aDados[i,1]
  
  
      ... chamo função para gravar
  Next



////////////////////////////DADOS DA FUNCAO////////////////////////////////////////////
// NOME       : LeExcel                                                              //
// AUTOR      : Evandro G. de Paula                                                  //
// COLABORAÇÃO: Gilmer Tavares (toda a parte OLE)                                    //
// SINTESE    : Ler arquivo xml                                                      //
// PARAMETROS : <1> cNome do arquivo xml                                             //
//              <2> Matriz a ser carregado os dados
//              <3> nTotal de colunas a ler (coluna limite a ser lida)               //
//              <4> aVetor com os números da coluna a serem efetivamente lidas       //
//              <5> nColuna verificação do conteúdo obrigatório. Caso a célula esteja//
//		              vazia, toda a linha será ignorada. (default=aVetor[1])          //
//              <6> Linha inicial na planilha a ser lida (padrão 1)
//              <7> Vetor para pegar dados no cabeçalho da planilha lida
//              <8> Array com as posições a serem lidas na planilhas <linha,coluna>
//              <9> .f. padrão lê apenas primeira aba, se for .t. lê todas
// RETORNO    : aVetor com os dados da planilha                                      //
///////////////////////////////////////////////////////////////////////////////////////

/* Chamada LeExcel(Vide Abaixo)
#include "FiveWin.ch"
Function Main()
  LeExcel( 'original', 4, {1,2,3,4},1 ) 
  //-> Uma chamada mais incrementada
  LeExcel( lNewFile,@aDados, 21, {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21},1,2,,.f. )
return nil
*/

Function LeExcel(cXlsArquivo,aVetor,nColunas,aColunas,nColObrig,nLinhaInicial,aTitulos,aColAd,cSheets)
  Local oDlg,oExcel,oFolha,nLinhas
  Local cProject, cFile, cRota:=cFILEPATH(GETMODULEFILENAME(GETINSTANCE()))
  // Tirei as 02 linhas abaixo pois não tem necessidade
  //cXlsArquivo+='.xls'  
  //cXlsArquivo:=strtran( cXlsArquivo, '.xls.xls','.xls' )
  if !file( cXlsArquivo )
		msgalert( 'Arquivo '+cXlsArquivo+' não encontrado.', 'Verifique' )
  else
      oExcel := TOleAuto():New( "Excel.Application" )
      //oExcel:Workbooks:Open(cRota+cXlsArquivo)
      oExcel:Workbooks:Open(cXlsArquivo)
      oFolha := oExcel:Get( "ActiveSheet" )
      oWork :=  oExcel:Get( "ActiveWorkbook" )
      oWork:Saved:=.t.
      nLinhas:=oFolha:UsedRange:Rows:Count()
      oExcel:Workbooks:Close()
      oExcel:Quit()
		LeArqExcel( cXlsArquivo,nColunas, aColunas,@aVetor, nColObrig,nLinhaInicial,aTitulos,aColAd,cSheets )
  endif
return aVetor

Function LeArqExcel( cXlsArquivo, nColunas, aColunas, aVetor, nColObrig, nLinhaInicial,aTitulos,aColAd,cSheets )
  Local aLinha
  Local cNome, cMatricula, cChave, cLinha
  Local nLinhas, x, x1, nPos
  Local oExcel, oFolha, oWork
  Local xLinha,nCol:=1,nDados:=0,nH,nSheets:=0,nF
  Local nT,nP,nColAd,lColAd,nContaAba:=1  //-> geraldo

  DEFAULT nColObrig:=aColunas[1]
  DEFAULT nLinhaInicial := 1
  DEFAULT cSheets := .f.
  
  
  oExcel := TOleAuto():New( "Excel.Application" )
  oExcel:Workbooks:Open(cXlsArquivo)
  //-> Verifica abas
  nSheets := oExcel:Sheets:Count()
  //-> Verifica se vai ler cabeçalho apenas da primeira planilha
  if cSheets = .f.
     nLerAba := 1
  else
     nLerAba := nSheets
  endif	   
  For nF := 1 to nSheets
		oExcel:Worksheets( nF ):Select()
      oFolha := oExcel:Get( "ActiveSheet" )
      oWork :=  oExcel:Get( "ActiveWorkbook" )
      oWork:Saved:=.t.
      **************************************************************************
		//-> Inclui essas linha para pegar cabeçalho (Geraldo 10/11/2009)
      If nContaAba <= nLerAba
		   if !empty(aColAd) 
            nColAd := Len(aColAd)
	         For nT = 1 to nColAd
                aAdd( aTitulos, {oFolha:Cells( aColAd[nT,1],aColAd[nT,2] ):Value } )
            Next
	         /* Como pegar os dados do cabeçalho
			   For nP = 1 to Len(aTitulos)
                ? aTitulos[nP,1] 
            Next
            */
		   endif
		   nContaAba++
		endif
		**************************************************************************
		nLinhas=oFolha:UsedRange:Rows:Count()
      For x:= nLinhaInicial to nLinhas
          xLinha:=oFolha:Cells( x, nColObrig ):Value
          if nColObrig > 0 .and. xLinha == nil
             loop
          endif
          aLinha:={}
          For x1 = 1 to nColunas
              if ascan( aColunas, x1 )>0
                 aadd( aLinha, oFolha:Cells( x, x1 ):Value )
              endif
          Next x1
          aAdd( aVetor, aLinha )
      Next x
  Next
  oExcel:Workbooks:Close()
  oExcel:Quit()
return aVetor

Sds,

Buenas Geraldo, consigo gravar em .DBF com esta rotina? Abs

Link to comment
Share on other sites
Geraldo (gbsilva) Newbie

Geraldo (gbsilva)

Posted
Posted

Olá João tudo bem!

Sim tranquilo, abaixo uma rotina bem antiga, mas usada ainda. A função para gravar esta dentro do For/Next a cada linha lida da planilha do excel atribui os valores aos atributos do objetos oCpo e grava no mysql, com DBF seria o mesmo processo.

Dúvidas a disposição.

STATIC function ImportaPastas(oCpo,aBEmpresas,aBServicos,aBPastas,aBTipos,aBases,oMet,nTotal)
  Local nP,nF,nT,aDados:={},aFalhas:={},nDados:=0,lContrato:="",cServico:="",lPasta:=space(10)
  Local nFalha :=0,lError:=0,nReg:=1,nFalhas:=0,lNewFile:="",cArquivo:=""
  Local lHoraInicio,lHoraFim,cTempo,conta:=0,lPeriodo:=space(4),lDefinePeriodo:=space(5) 
  Local aClasses:={},cRetorno:=space(1),lAnexo:=space(4),lTipoObra:=space(1)
  Local lNumberTel:=space(7),nNumberTel:=0,cContrato:="",cBase:="",lGrupoAcq:=space(7)
  Local lPep1:="",lPep2:="",cFirstGrupo:=space(7)
  local nTipoAnexo := 0
  
  If !AutoMan(,2)
	  return(.f.)
  Endif

  If empty(left(oCpo:periodo,2)) .or. empty(right(oCpo:periodo,2))
     GbMsg("Favor digitar o período das obras!",,2)
     GbFoco(oMet[1])
	  return(.f.)
  Endif
  
  If !ClasseObras(aClasses)
     GbMsg("Não foi carregados tipos de obras!",,2)
     GbFoco(oMet[1])
	  return(.f.)
  Endif
  lPeriodo := (right(oCpo:periodo,2)+left(oCpo:periodo,2))
  lDefinePeriodo := lPeriodo+cRetorno

  cArquivo:= cGetFile32("*.XLS","Escolha o arquivo")
  IF !File(cArquivo)   
      RETURN
  ENDIF
  lNewFile := cArquivo

  cursorwait()

  LeExcel( lNewFile,@aDados, 24, {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24},1,2,,.f. )
  nDados:=Len(aDados)
  lHoraInicio := Time()
  oMet[2]:ntotal = nDados
  if nDados = 0
     GbMsg("Nenhuma obra foi encontrada na planilha de origem, favor verificar!",,2)
     GbFoco(oMet[5])
	  return(.f.)
  endif
  //-> Ordena matriz para pegar o menor grupo_acq na primeira linha
  ASORT(aDados,,,{|x,y| x[1] < y[1] })
  //-> Iguala para carregar apenas obras já gravadas a partir do menor grupo_acq da importação
  cFirstGrupo := STR(aDados[1,1],0)
  //-> Atualiza texto ao iniciar barra 
  oCpo:processo  := "Carregando Tabelas [Empresas, Serviços e Obras]...Aguarde [GbSoftware]"
  oMet[3]:SetText(oCpo:processo) 

  If !CarregaPastas(@aBPastas,cFirstGrupo)
     GbFoco(oMet[5])
	  return(.f.)
  Endif
  //-> Carrega array com obras já cadastradas de acordo com maior grupo da planilha a ser importada
  CarregaEmpresas(@aBEmpresas)
  
  CarregaServicos(@aBServicos)
  CarregaGisBase(aBases)
  
  //-> Atualiza texto ao iniciar barra 
  oCpo:processo  := "Lendo Planilha Excel...Aguarde [GbSoftware]"
  oMet[3]:SetText(oCpo:processo) 
  //-> Atualiza texto ao iniciar barra 
  oCpo:processo  := "Importando Obras...Aguarde [GbSoftware]"
  oMet[3]:SetText(oCpo:processo) 

  For nP = 1 to nDados
		//-> se a coluna tiver preenchimento consulta tabela cad_nome_obras
		oCpo:tipo_obra := space(1)
		oCpo:tipo      := space(1)
		nTipoAnexo := 0
		if !empty(aDados[nP,7])
			if !MClasse(oCpo,aClasses,aDados[nP,7])
            aAdd(aFalhas,{alltrim(STR(aDados[nP,1],0)),"Não encontrou classe de obra"} )
			   loop
		   endif
		   oCpo:tipo := oCpo:tipo_obra
		else
		  if empty(oCpo:tipo) //-> se for vazio entra nessa opção antiga
		     if empty(aDados[nP,7]) .AND. empty(aDados[nP,10]) //-> Não tem anexo e gerobras então é Manutenção
		        oCpo:tipo := "M" //-> Obra de Manutenção
			  else
			     if empty(aDados[nP,7]) //-> Se for vazio ANEXO 
					  aAdd(aFalhas,{alltrim(STR(aDados[nP,1],0)),"Implantação sem ANEXO 1"} )
			        loop
		        endif
			     oCpo:tipo := "I" //-> Obra de Implantação
			     oCpo:m_obra := "T"
		        lAnexo := aDados[nP,7]
		        nTipoAnexo := 1
		     endif
        else
           oCpo:tipo := oCpo:tipo_obra
        endif
		endif
		if oCpo:tipo = "M"  //-> Manutenção
			if !empty(aDados[nP,7]) //-> Anexo preenchido
			   lAnexo := aDados[nP,7]
			   if alltrim(upper(aDados[nP,8])) == "ATIVIDADE"  .OR. upper(aDados[nP,8]) = "ATIVIDADES"
		         oCpo:m_obra := "T"
		      else
				   oCpo:m_obra := "A"
				endif 
			else
			   If alltrim(upper(aDados[nP,8])) == "ATIVIDADE"  .OR. upper(aDados[nP,8]) = "ATIVIDADES"
		         oCpo:m_obra := "T"
		         lTipoObra   := "1"
		      Elseif alltrim(upper(aDados[nP,8])) == "ATIVIDADE /POU" 
		         oCpo:m_obra := "T"
		         lTipoObra   := "2"
		      Elseif alltrim(upper(aDados[nP,8])) == "ACESSO" 
		         oCpo:m_obra := "A"
		         lTipoObra   := "1"
		      Else
               aAdd(aFalhas,{alltrim(STR(aDados[nP,1],0)),"Faltou mão de obra"} )
			      loop
		      Endif
		      If alltrim(aDados[nP,24]) == "FO"
		         If oCpo:m_obra = "T"
		            lAnexo := "OR03"  //-> Manutenção Fibra Atividade (ver tabela cad_nome_obras)
		         Else
			         lAnexo := "OR04"  //-> Manutenção Fibra Acesso (ver tabela cad_nome_obras)
			      Endif   
		      Else
		         If oCpo:m_obra = "T" .AND. lTipoObra = "1"   //-> OR normal Atividade
		            lAnexo := "OR02"
		         Elseif oCpo:m_obra = "T" .AND. lTipoObra = "2"  //-> POU Atividade
			         lAnexo := "PU01"
		         Elseif oCpo:m_obra = "A" .AND. lTipoObra = "2"  //-> POU Acesso
			         lAnexo := "PU01"
		         Elseif oCpo:m_obra = "A" .AND. lTipoObra = "1"  //-> OR normal Acesso
			         lAnexo := "OR01"
			      Endif   
            Endif
         Endif //? "M3 - Anexo",oCpo:tipo,lAnexo,"Com Tipo"
		else //-> Obras de Implantação
			if nTipoAnexo = 0
			   If empty(aDados[nP,7]) //-> Se for vazio ANEXO 
               aAdd(aFalhas,{alltrim(STR(aDados[nP,1],0)),"Implantação sem ANEXO 2"} )
			      loop
		      Endif
			   oCpo:tipo := "I" //-> Obra de Implantação
			   oCpo:m_obra := "T"
		      lAnexo := aDados[nP,7]
		   endif
		endif
		If !MClassificacao(oCpo,aClasses,lAnexo,@cRetorno)
         aAdd(aFalhas,{alltrim(STR(aDados[nP,1],0)),"Não encontrou classe de obra"} )
			loop
      Endif
      //-> Definindo número da pasta
		lDefinePeriodo := lPeriodo+cRetorno  //-> Período digitado + classe da tabela cad_nome_obras
		lNumberTel     := StrZero(aDados[nP,1],7) //-> Pega grupo da planilha do gcore
		oCpo:codigo    := lDefinePeriodo+lNumberTel //-> A junção dos dois gera o número da pasta 
		//-> Pega o grupo_acq do gcore para gravar na tabela cad_obras
		lGrupoAcq      := STR(aDados[nP,1],0)
		oCpo:grupo_acq := VAL(lGrupoAcq)
		********************************************************************
		//-> Pega o número do contrato na planilha e faz a busca em MEmpresa() para identificar a empresa da obra
		If valtype(aDados[nP,2]) = "N"
		   cContrato := STR(aDados[nP,2],0)
		Else
		   cContrato := alltrim(aDados[nP,2])
	   Endif
		If MEmpresa(oCpo,aBEmpresas,cContrato)
			If valtype(aDados[nP,4]) = "N"
			   oCpo:zona := STR(aDados[nP,4],2)
			Else
			   oCpo:zona := alltrim(aDados[nP,4])
			Endif   
		   oCpo:escritorio := aDados[nP,5]
		   oCpo:estacao    := aDados[nP,6]
		Else
			aAdd(aFalhas,{alltrim(STR(aDados[nP,1],0)),"Não achou empresa"} )
			loop
		Endif
		//-> Identifica o tipo de serviço da obra
		If !MServico(oCpo,aBServicos,oCpo:nome_obra)
			aAdd(aFalhas,{alltrim(STR(aDados[nP,1],0)),"Não achou tipo serviço"} )
			loop
		Endif
		//-> Modificado para tratar se o gerobras estiver na coluna errada
		If !empty(aDados[nP,9])
			//-> se tem gerobras então não tem projeto/sgci ai zera a variável oCpo:projeto
			oCpo:projeto := space(15)
			If VALTYPE(aDados[nP,9]) = "N"
			   oCpo:pep := alltrim(STR(aDados[nP,9],10,0))
			Else
			   //-> Trata, pois em alguns casos vem apenas um traço na planilha
				If alltrim(aDados[nP,9]) = "-"
				   oCpo:pep := space(10)
				Else //-> se tiver traço no meio do pep trata e tira o traço  
					lPep1 := alltrim(StrToken(aDados[nP,9],1,"-"))
               lPep2 := alltrim(StrToken(aDados[nP,9],2,"-"))
					oCpo:pep := lPep1+lPep2
				Endif	
			Endif   
		   //-> Se estiver na coluna 10 o gerobras sai daqui  (as vezes o gerobras vem na coluna projeto)
			If !empty(aDados[nP,10])
		      If VALTYPE(aDados[nP,10]) = "N"
			      oCpo:gerobras := alltrim(STR(aDados[nP,10],30,0))
			   Else
			      If alltrim(aDados[nP,10]) = "-"
				      oCpo:gerobras := space(30)
				   Else   
			         oCpo:gerobras := alltrim(aDados[nP,10])
			      Endif   
			   Endif   
		   Endif
		   //-> Se estiver na coluna 11 o gerobras sai daqui
			If !empty(aDados[nP,11])
		      If VALTYPE(aDados[nP,11]) = "N"
			      oCpo:gerobras := alltrim(STR(aDados[nP,11],30,0))
			   Else
			      //-> Trata, pois em alguns casos vem apenas um traço na planilha
					If alltrim(aDados[nP,11]) = "-"
				      oCpo:gerobras := space(30)
				   Else   
			         oCpo:gerobras := alltrim(aDados[nP,11])
			      Endif   
			   Endif   
		   Endif
		Else   //-> se é projeto/sgci zera variáveis pep e gerobras 
		   oCpo:pep      := space(10)
		   oCpo:gerobras := space(30)
		   If !empty(aDados[nP,11])
		      If VALTYPE(aDados[nP,11]) = "N"
			      oCpo:projeto := alltrim(STR(aDados[nP,11],15,0))
			   Else
			      //-> Trata, pois em alguns casos vem apenas um traço na planilha
					If alltrim(aDados[nP,11]) = "-"
				      oCpo:projeto := space(15)
				   Else   
			         oCpo:projeto := alltrim(aDados[nP,11])
			      Endif   
			   Endif   
		   Else
		      oCpo:projeto := space(15)
		   Endif
		Endif
		//-> Os campos 12 a 15 são tratados se no valor vier ponto em vez de vírgula
		If !empty(aDados[nP,12])
			IF VALTYPE(aDados[nP,12]) = "N"
			   oCpo:pontol := aDados[nP,12]
			ELSE
			   IF AT(",",aDados[nP,12]) = 0
			      oCpo:pontol := aDados[nP,12]
			   ELSE
			      oCpo:pontol := STRTRAN(aDados[nP,12],",",".")
			   ENDIF
			ENDIF
		Else
		   oCpo:pontol := '0'
		Endif   
		If !empty(aDados[nP,13])
			IF VALTYPE(aDados[nP,13]) = "N"
			   oCpo:pontoc := aDados[nP,13]
			ELSE
			   IF AT(",",aDados[nP,13]) = 0
			      oCpo:pontoc := aDados[nP,13]
			   ELSE
			      oCpo:pontoc := STRTRAN(aDados[nP,13],",",".")
			   ENDIF
			ENDIF
		Else
		   oCpo:pontoc := '0'
		Endif   
		If !empty(aDados[nP,14])
			IF VALTYPE(aDados[nP,14]) = "N"
			   oCpo:pontog := aDados[nP,14]
			ELSE
			   IF AT(",",aDados[nP,14]) = 0
			      oCpo:pontog := aDados[nP,14]
			   ELSE
			      oCpo:pontog := STRTRAN(aDados[nP,14],",",".")
			   ENDIF
			ENDIF
		Else
		   oCpo:pontog := '0'
		Endif                                   
		If !empty(aDados[nP,15])
			IF VALTYPE(aDados[nP,15]) = "N"
			   oCpo:valor := aDados[nP,15]
			ELSE
			   IF AT(",",aDados[nP,15]) = 0
			      oCpo:valor := aDados[nP,15]
			   ELSE
			      oCpo:valor := STRTRAN(aDados[nP,15],",",".")
			   ENDIF
			ENDIF
		Else
		   oCpo:valor := '0'
		Endif   
		//-> Título da obra
	   If !empty(aDados[nP,16])
	      If alltrim(aDados[nP,16]) = "-"
			   oCpo:titulo := space(1)
			Else   
				oCpo:titulo := alltrim(aDados[nP,16])
			Endif   
		Else
		   oCpo:titulo := space(1)
		Endif
		//-> Nome da Cidade
	   If !empty(aDados[nP,17])
	      If alltrim(aDados[nP,17]) = "-"
			   oCpo:localidade := space(1)
			Else   
				oCpo:localidade := alltrim(aDados[nP,17])
			Endif   
		Else
		   oCpo:localidade := space(1)
		Endif
		//-> CNL
	   If !empty(aDados[nP,19])
		   If VALTYPE(aDados[nP,19]) = "N"
			   oCpo:cnl := alltrim(STR(aDados[nP,19],0))
			Else
			   If alltrim(aDados[nP,19]) = "-"
			      oCpo:cnl := space(1)
			   Else   
				   oCpo:cnl := alltrim(aDados[nP,19])
			   Endif   
		   Endif
		Else
		   oCpo:cnl := space(1)
		Endif
		//-> Nome da Central (Invertido para pegar o CNL pronto)
		cBase := (oCpo:escritorio+oCpo:estacao+oCpo:cnl)
		If !MBase(oCpo,aBases,cBase)
		   oCpo:gis     := space(4)
		   oCpo:base    := space(15)
		   oCpo:central := space(30)
		Endif
		cBase := ""
		//-> Endereço
	   If !empty(aDados[nP,20])
	      if VALTYPE(aDados[nP,20]) = "N"
			  if aDados[nP,20] = "-"
			     oCpo:endereco := space(1)
			  else   
				  oCpo:endereco := aDados[nP,20]
			  endif   
	      else
			  If alltrim(aDados[nP,20]) = "-"
			     oCpo:endereco := space(1)
			  Else   
				  oCpo:endereco := alltrim(aDados[nP,20])
			  Endif   
	      endif
		Else
		   oCpo:endereco := space(1)
		Endif
		//-> Observações
		oCpo:historico := ""  //-> Limpando variável antes de ler a coluna
	   If !empty(aDados[nP,21])
	      If alltrim(aDados[nP,21]) = "-"
			   oCpo:historico := ""
			Else   
				oCpo:historico := alltrim(aDados[nP,21])
			Endif   
		Else
		   oCpo:historico := ""
		Endif
		lError := 0 //-> Padrão é erro zero se houver algum problema modifica na funçao MPasta() antes de gravar
		If !GravaObra(oCpo,aDados,aBPastas,@lError)
			If lError = 1
			   aAdd(aFalhas,{alltrim(STR(aDados[nP,1],0)),"Duplicidade de pasta"} )
			Elseif lError = 2
			   aAdd(aFalhas,{alltrim(STR(aDados[nP,1],0)),"Erro de gravação"} )
			Endif
			loop
		Endif
		oMet[2]:Set(nReg)
      oMet[2]:cText:="Obra Nº "+ Strzero(nReg,6)+" de "+Strzero(nDados,6)+" Gravado Pasta: "+oCpo:pasta +SPACE(10)
      oMet[2]:Refresh()
		nReg++
  Next
  cursorarrow()
  lHoraFim := Time()
  cTempo := ElapTime(lHoraInicio,lHoraFim)
  nFalhas := Len(aFalhas)
  If nFalhas > 0
     oCpo:processo  := "Importação concluída - Tempo: "+cTempo
	  oMet[3]:SetText(oCpo:processo) 
     If !MsgYesNo("Não foram importadas "+strzero(nFalhas,4)+" pastas, deseja verificar (S/N) ?"+CRLF+;
	               "Tempo Decorrido: "+cTempo,"Atenção")
	     return(nil)
	  Endif 
	  ListaFalhas(aFalhas)
  Else
     oCpo:processo  := "Importação concluída com sucessco - Tempo: "+cTempo
	  oMet[3]:SetText(oCpo:processo) 
  Endif
  GbFoco(oMet[5])
return(nil)

STATIC Procedure ListaFalhas(aFalhas)
  local oWnd,oBrw,oFont,nFont,oHand,oIco,oDlg,oFalha[4],oSay
  local nF,nFalhas := Len(aFalhas)
  local lAviso := "Botão Direito = Menu Suspenso"
  
  DEFINE FONT nFont  NAME "Ms Sans Serif" SIZE 0,-10 
  DEFINE FONT oFont NAME "Time New Roman" SIZE 0,14 BOLD
  DEFINE CURSOR oHand RESOURCE "Dedo"
  DEFINE ICON OICO RESOURCE "MONEY"
  DEFINE DIALOG oDlg RESOURCE "TELA01" OF oDlg ;
			ICON oIco TITLE "Obras não Importadas"
  oDlg:lHelpIcon := .F.

  **********************************************************************************
  oBrw := TXBrowse():New( oDlg )     
  oBrw:CreateFromResource( 601 )  //--> Chamada ao Resource Browse.
  oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW  //--> Estilo da barra de seleçao.       
                                                    //HBLUE
  oBrw:bClrSelFocus := {|| { CLR_BRANCO, CLR_HRED } }  //--> Cor da barra de seleçao.
  oBrw:SetArray(aFalhas)

  oBrw:aCols[1]:cHeader      := "PASTA"
  oBrw:aCols[1]:nDataStrAlign := AL_LEFT
  oBrw:aCols[1]:nHeadStrAlign := AL_LEFT

  oBrw:aCols[2]:cHeader      := "OBSERVAÇÃO"
  oBrw:aCols[2]:nDataStrAlign := AL_LEFT
  oBrw:aCols[2]:nHeadStrAlign := AL_LEFT

  GbColuna(oBrw,{10,50 })
  oBrw:bRclicked :={ |nRow,nCol| PopUp(,,aFalhas[oBrw:nArrayAt,1],aFalhas,oBrw,nRow,nCol,oWnd,oBrw,.f.,.f.) }
  oBrw:nStretchCol := STRETCHCOL_LAST
  oBrw:refresh()
  **********************************************************************************
  REDEFINE SAY oSay VAR lAviso ID 501 OF oDlg ;
           FONT oFont COLORS CLR_HRED,CLR_LGREEN

  REDEFINE SBUTTON oFalha[1] RESOURCE "FECHAR" PROMPT "Fechar" ID 701 OF oDlg ;
 		     ACTION( oDlg:End() ) TOOLTIP "Fecha tela" 

  ACTIVATE DIALOG oDlg CENTERED
  GbDlg(oDlg)
return nil

STATIC function GravaObra(oCpo,aDados,aBPastas,lError)
  Local cMsg,cLog,cCmd,oPasta,lstatus := '00'
  //-> Verifica se já existe pasta cadastrada (Usando Ascan() )
  If !MPasta(aBPastas,oCpo:grupo_acq)
     lError := 1
	  return(.f.)
  Endif
  TRY
	 if !GbInsert("cad_obras",{ {"pasta",oCpo:codigo},;
	                            {"id_empresa",oCpo:id_empresa},;
	   			    {"id_contrato",oCpo:id_contrato},;
                                    {"zona",oCpo:zona},;
				    {"es",oCpo:escritorio},;
				    {"at",oCpo:estacao},;
                                    {"id_servico",oCpo:id_servico},;
			            {"m_obra",oCpo:m_obra},;
                                    {"periodo",oCpo:periodo},;
				    {"pep",oCpo:pep},;
                                    {"gerobras",oCpo:gerobras},;
				    {"projeto",oCpo:projeto},;
                                    {"pontol",oCpo:pontol},;
				    {"pontoc",oCpo:pontoc},;
                                    {"pontog",oCpo:pontog},;
				    {"valor",oCpo:valor},;
                                    {"tipo",oCpo:tipo},;
				    {"status",lStatus},;
				    {"localidade",left(Aspas(oCpo:localidade),30)},;
				    {"central",left(Aspas(oCpo:central),30)},;
				    {"cnl",oCpo:cnl},;
			            {"endereco",left(Aspas(oCpo:endereco),50)},; 
				    {"titulo",left(Aspas(oCpo:titulo),50)},;
				    {"gis",oCpo:gis},;
				    {"base",oCpo:base},;
				    {"grupo_acq",oCpo:grupo_acq} } )
       cMsg := "Erro ao gravar amostra (Tabela Cad_Obras) - Pasta: "+oCpo:codigo 
       BREAK
    endif
	 If !empty(oCpo:historico)
	    if !GbInsert("obs_obras",{ {"pasta",oCpo:codigo},{"historico",Aspas(oCpo:historico)} } )
          cMsg := "Erro ao histórico da obra" 
          BREAK
       endif
	 Endif
  CATCH
    GbRollBack()
    GbErro(cMsg)
    return(.f.)
  END
  GbCommit()
return(.t.)
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
×
 Share
Go to topic listing
×
×
  • Create New...