XBROWSER y exportar a Excel con Meter

[Enrrique Vertiz]

Estimados, buenas noches

Uso este TxB para mostrar informacion contable, en _ los clientes quieren exportar gran cantidad de informacion a Excel, el Boton funciona, pero "no muestra ningun proceso" y el usuario piensa que no esta funcionando, como se activa o se coloca un Meter para saber que se esta procesando.
Gracias.

[armando.lagunas]

Hola
esto el lo que ocupo yo para lo que solicitas:

Archivo RC para WorkShop

Code: Select all

0_EXCEL01 DIALOG 187, 195, 527, 92
STYLE 0x4L | WS_POPUP | WS_VISIBLE | WS_BORDER
FONT 8, "Segoe UI Symbol"
{
 PUSHBUTTON "&Aceptar", 18, 192, 58, 69, 20
 PUSHBUTTON "&Exit", 19, 265, 58, 69, 20
 CTEXT "Text", 10, 12, 10, 503, 21
 CONTROL "", 13, "msctls_progress32", 0 | WS_CHILD | WS_VISIBLE, 48, 46, 430, 3
 

Función para el usuario para la construcción del excel ( solo como ejemplo )

Code: Select all

FUNCTION ExportExcel( oBrw, cTitulo )
 LOCAL oDlg, oMet, oB

 DEFINE BRUSH oB GRADIENT { { 1, nRgb( 74, 97, 132 ), nRgb( 33, 47, 72 ) } }
 DEFINE DIALOG oDlg RESOURCE "0_EXCEL01" BRUSH oB

      REDEFINE STSAY     ID 10 PROMPT "Enviar datos a Microsoft Excel®" OF oDlg FONT oApp:aWFont[4] COLOR nRGB(252,224, 29), __CLR85

      oMet := TProgress():Redefine( 13, oDlg )

      REDEFINE SBUTTON ID 18 PROMPT "Construir" OF oDlg ACTION ( ExcelConstructor( oBrw, oMet, cTitulo ), oDlg:End() ) NOBOX RECT FONT oApp:aWFont[2] COLOR FRE_FBTN, { FRE_RBTN, __CLR87 }
      REDEFINE SBUTTON ID 19 PROMPT "Abandonar" OF oDlg ACTION oDlg:End()                                              NOBOX RECT FONT oApp:aWFont[2] COLOR FRE_FBTN, { FRE_RBTN, __CLR87 }

 ACTIVATE DIALOG oDlg CENTER
 oB:End()
 oBrw:Refresh()
 oBrw:Gotop()
 oBrw:SetFocus()

 RETURN .T.
 
 

funcion de construccion del excel en base al xBrowse enviado

Code: Select all

FUNCTION ExcelConstructor( oBrw, oMeter, cTitle )
 LOCAL oExcel, oBook, oSheet, nRow, nCol, uData, nEvery, oRange, cRange, cCell, cLet, nColHead, bError, cText, oClip, nStart, aRepl, ;
      nLine  := 1,  nCount := 0,  aCol := { 26, 52, 78, 104, 130, 156 }, aLet := { "", "A", "B", "C", "D", "E" }, xWin

      CursorWait()
      cLet := aLet[ ASCAN( aCol, {|e| LEN( oBrw:aCols ) <= e } ) ]
      IF !EMPTY( cLet )
           nCol := ASCAN( aLet, cLet ) - 1
           cLet += CHR( 64 + LEN( oBrw:aCols ) - aCol[ MAX( 1, nCol ) ] )
      ELSE
           cLet := CHR( 64 + LEN( oBrw:aCols ) )
      ENDIF
      aRepl      := {}
      oMeter:SetRange( 0, ( oBrw:nLen + 1 ) )
      oMeter:Setpos( 0 )
      oMeter:Refresh()
      nEvery := MAX( 1, INT( ( oBrw:nLen + 1 ) * .02 ) )
      bError := ErrorBlock( { | x | Break( x ) } )
      BEGIN SEQUENCE
            oExcel := TOleAuto():New("Excel.Application")
      RECOVER
            ErrorBlock( bError )
            CursorArrow()
            MsgFlip( "Excel no se encuentra instalado..." )
            RETURN Nil
      END SEQUENCE
      ErrorBlock( bError )
      nCount -= 15
      oMeter:SetPos( nCount )
      oExcel:ScreenUpdating := .F.
      oExcel:WorkBooks:Add()
      oBook  := oExcel:Get( "ActiveWorkBook")
      oSheet := oExcel:Get( "ActiveSheet" )
      nCount -= 15
      oMeter:SetPos( nCount )

      ( oBrw:cAlias )->( Eval( oBrw:bGoTop() ) )

      cText := ""
      FOR nRow := 1 TO oBrw:nLen
          IF nRow == 1
             oSheet:Cells( nLine++, 1 ):Value := cTitle
             oSheet:Range( "A1:" + cLet + "1" ):Set( "HorizontalAlignment", 7 )
             ++nLine
             nStart := nLine

             nColHead := 0
             FOR nCol := 1 TO LEN( oBrw:aCols )
                 uData := IIF( VALTYPE( oBrw:aCols[ nCol ]:cHeader ) == "B", EVAL( oBrw:aCols[ nCol ]:cHeader ), oBrw:aCols[ nCol ]:cHeader )
                 IF VALTYPE( uData ) != "C"
                    LOOP
                 ENDIF
                 uData := STRTRAN( uData, CRLF, Chr( 10 ) )
                 nColHead ++
                 oSheet:Cells( nLine, nColHead ):Value := uData
                 IF nCount % nEvery == 0
                    oMeter:SetPos( nCount )
                 ENDIF
                 nCount ++
             NEXT
             nStart := ++ nLine
          ENDIF
          FOR nCol := 1 To Len( oBrw:aCols )
              uData := EVAL( oBrw:aCols[ nCol ]:bEditValue )
              IF VALTYPE( uData ) == "C" .AND. AT( CRLF, uData ) > 0
                 uData := STRTRAN( uData, CRLF, "&&" )
                 IF ASCAN( aRepl, nCol ) == 0
                     AADD( aRepl, nCol )
                 ENDIF
              ENDIF
              IF oBrw:aCols[ nCol ]:cEditPicture != Nil
                 uData := TRANSFORM( uData, oBrw:aCols[ nCol ]:cEditPicture )
              ENDIF
              uData  :=  IIF( VALTYPE( uData )=="D", DTOC( uData ), ;
                         IIF( VALTYPE( uData )=="N", STR( uData ) , ;
                         IIF( VALTYPE( uData )=="L", IIF( uData ,".T." ,".F." ), cValToChar( uData ) ) ) )

              cText += TRIM( uData ) + Chr( 9 )
              IF nCount % nEvery == 0
                 oMeter:SetPos( nCount )
              ENDIF
              nCount ++
          NEXT
          oBrw:Skip( 1 )
          cText += CHR( 13 )
          ++nLine
          IF LEN( cText ) > 400000
             oClip := TClipBoard():New()
             oClip:Clear()
             oClip:SetText( cText )
             cCell := "A" + AllTrim( Str( nStart ) )
             oRange := oSheet:Range( cCell )
             oRange:Select()
             oSheet:Paste()
             oClip:End()
             cText := ""
             nStart := nLine + 1
          ENDIF
      NEXT
      IF ASCAN( oBrw:aCols, { |o| o:cFooter != Nil  } ) > 0
         FOR nCol := 1 TO LEN( oBrw:aCols )
             uData := IIF( VALTYPE( oBrw:aCols[ nCol ]:cFooter ) == "B", EVAL( oBrw:aCols[ nCol ]:cFooter ), oBrw:aCols[ nCol ]:cFooter )
             uData := cValTochar( uData )
             uData := STRTRAN( uData, CRLF, Chr( 10 ) )
             oSheet:Cells( nLine, nCol ):Value := uData
         NEXT
      ENDIF

      oSheet:Rows( 1 ):Font:Bold   := .T.
      ( oBrw:cAlias )->( DbGoTop() )

      IF LEN( cText ) > 0
         oClip := TClipBoard():New()
         oClip:Clear()
         oClip:SetText( cText )
         cCell := "A" + AllTrim( Str( nStart ) )
         oRange := oSheet:Range( cCell )
         oRange:Select()
         oSheet:Paste()
         oClip:End()
         cText := ""
      ENDIF
      nLine := If( ! Empty( cTitle ), 3, 1 )
      cRange := "A" + LTrim( Str( nLine ) ) + ":" + cLet + AllTrim( Str( oSheet:UsedRange:Rows:Count() ) )
      oRange := oSheet:Range( cRange )
      oRange:Font:Name := "Roboto Cn"
      oRange:Font:Size := 12
      oRange:Font:Bold := .F.
      IF ! EMPTY( aRepl )
         FOR nCol := 1 TO LEN( aRepl )
             oSheet:Columns( CHR( 64 + aRepl[ nCol ] ) ):REPLACE( "&&", CHR( 10 ) )
         NEXT
      ENDIF
      oSheet:Rows( 1 ):Font:Size       := 14
      oSheet:Rows( 1 ):Font:Bold       := .T.
      oSheet:Rows( 1 ):RowHeight       := 30
      oSheet:Rows( 1 ):Font:ColorIndex := 25

      oSheet:Rows( 3 ):Font:Bold       := .T.
      oSheet:Rows( 3 ):Font:ColorIndex := 20
      oSheet:Rows( 3 ):RowHeight       := 25
      oRange:Borders():LineStyle := 1
      oRange:Columns:AutoFit()
      IF ! Empty( aRepl )
         FOR nCol := 1 TO LEN( aRepl )
            oSheet:Columns( CHR( 64 + aRepl[ nCol ] ) ):WrapText := .T.
         NEXT
      ENDIF
      oMeter:SetPos( ( oBrw:nLen + 1 ) )
      oSheet:Range( "A3:"+cLet+"3" ):Interior:ColorIndex := 49
      oSheet:Range( "A3:"+cLet+"3" ):Borders:ColorIndex  := 2
      oSheet:Range( "A4" ):Select()
      xWin   := oExcel:ActiveWindow
      *xWin:SplitRow := 3
      oExcel:ScreenUpdating   := .t.
      oExcel:Visible := .T.
      ShowWindow( oExcel:hWnd, 3 )
      BringWindowToTop( oExcel:hWnd )
      CursorArrow()

 RETURN NIL

 

lo uso aplicandolo a un boton cualquiera ( marcado en la imagen )

Code: Select all

                   REDEFINE SBUTTON ID  43 FILENAME ".\System\SendToExcel.bmp" OF oDlg ACTION ExportExcel( oBrw,"DESPACHOS EFECTUADOS EN TEMPORADA") ;
                                                                                                                                   COLOR __CLRBOTON TOOLTIP "Traslado de información..."
 

Resultado :





Espero que te sirva

PD. aplicable para versiones antiguas de FiveWin.

[Enrrique Vertiz]

Saludos Armando

Muchas gracias por tu extensa y clara explicacion, obviamente "es eso lo que necesito", pero pense que en la nueva XBROWSER de FWH que te arma el Browse con solo las lineas abajo adjuntas como ejemplo y que tiene un boton que manda a Excel, podria incluir lo que aqui tu amablemente compartes, sino tendre que hechar mano de tu ejemplo
Gracias nuevamente.

USE CUSTOMER
XBROWSER "CUSTOMER" COLUMNS "FIRST","LAST" SETUP oBrw:cHeaders := { "FirstName", "LastName" }

[Enrrique Vertiz]

Saludos Armando

Muchas gracias por el ejemplo, es 100% lo que necesito, pense que la propia clase ya podria tener esto resuelto, si trae el boton para exportar no se que tan complicado sea aumentar a ese boton el meter, sobre todo para el caso de la exportacion de archivos con miles de registros.

[nageswaragunupudi]

Xbrowse's native method

Code: Select all

oBrw:ToExcel( [bProgress] )
 

is very fast even for thousands of records and using a progress meter slows down the export.
Still, if you want to show your own meter you can do this

Code: Select all

oBrw:ToExcel( { |nRowsExported, nTotalRows| YourMeterFunc( nRowsExported, nTotalRows ) } )
 

By default, XBrowse displays the progress on the MsgBar of the window containing the browse.

We recommend using built-in method ToExcel().

[Enrrique Vertiz]

Thanks Mr Rao for your info ...

[FranciscoA]

Aquí tienes un ejemplo. (No recuerdo de donde lo bajé)

Code: Select all

function Exp2Xls_1_ProgressB()

   local oDlg, oBrw

   DBUSEAREA(.T.,,"CUSTOMER","CUST",.T.)

   DEFINE DIALOG oDlg SIZE 800,500 PIXEL 

   @ 0,0 XBROWSE oBrw OF oDlg ;
         DATASOURCE 'CUST' ;
         AUTOCOLS CELL LINES

   oBrw:CreateFromCode()
   oDlg:oClient := oBrw

   ACTIVATE DIALOG oDlg CENTERED ;
        ON INIT ( DlgMenu1(oDlg,oBrw) )

   CUST->(DBCLOSEAREA())

return nil
//-------------------------------------------------------------
static function Exp1ToExcel( oBrw, oMeter, oText, oDlg, lEnd )

   oBrw:ToExcel( { |n,t| oMeter:nTotal := t, ;
                         oMeter:Set( n ), ;
                         oText:SetText( Str(n) + '/' + Str(t) ), ;
                         oDlg:Update(), .t. } )

return nil
//---------------------//
Function DlgMenu1(oDlg,oBrw)
local oMenu, oBar

MENU oMenu 2007 
     MENUITEM "&Excel"  ACTION MsgMeter( { |oMeter, oText, oDlg, lEnd | ;
                               Exp1ToExcel( oBrw, oMeter, oText, oDlg, @lEnd ) } )
     MENUITEM "&Salir"  ACTION oDlg:End()
ENDMENU
oDlg:SetMenu(oMenu)

return nil
 

Saludos.

[Enrrique Vertiz]

Saludos Señores

Gracias por sus respuestas, pero no es en XBROWSE donde deseo implementarlo sino en el XBROWSER que es una version compacta y resumida del XBROWSE, es ahi donde me pregunto, si hay un ejemplo de como colocar el meter en el boton Excel que aparece por defecto, con esta sentencia no se define dialogo ni nada solo se escribe una linea :

XBROWSER "DIARIO" TITLE "Movimientos"

Y listo muestra el Browse completo con una serie de botonos, uno de ellos es el que exporta a Excel a esa funcion necesito colocarle el meter, aunque ponga mas lento el proceso, porque es mejor lento con un meter, que menos lento pero sin meter y que el usuario no sepa que esta pasando.
Ademas saber si existe alguna forma de desabilitar los demas botones que uno no quiera usar del XBROWSER

Gracias

[joseluisysturiz]

Saludos Señores

Gracias por sus respuestas, pero no es en XBROWSE donde deseo implementarlo sino en el XBROWSER que es una version compacta y resumida del XBROWSE, es ahi donde me pregunto, si hay un ejemplo de como colocar el meter en el boton Excel que aparece por defecto, con esta sentencia no se define dialogo ni nada solo se escribe una linea :

XBROWSER "DIARIO" TITLE "Movimientos"

Y listo muestra el Browse completo con una serie de botonos, uno de ellos es el que exporta a Excel a esa funcion necesito colocarle el meter, aunque ponga mas lento el proceso, porque es mejor lento con un meter, que menos lento pero sin meter y que el usuario no sepa que esta pasando.
Ademas saber si existe alguna forma de desabilitar los demas botones que uno no quiera usar del XBROWSER

Gracias

Saludos, porque no usas un msgrun().? gracias...

[FranciscoA]

Saludos Señores

Y listo muestra el Browse completo con una serie de botonos, uno de ellos es el que exporta a Excel a esa funcion necesito colocarle el meter, aunque ponga mas lento el proceso, porque es mejor lento con un meter, que menos lento pero sin meter y que el usuario no sepa que esta pasando.

Gracias

Hola.
Creo que te refieres a la function xBrowse que se encuentra en \source\functions\xBrowser.prg
Tendrías que modificar esta function y agregarla como un .prg a tu proyecto.
Aqui dejo como lo he hecho.

Mi versión es la 1204.

Trabaja con una copia del xBrowser.prg y renombra como My_xBrowser.prg, asi mismo a la function.

Localiza y cambia lo siguiente:

Code: Select all

   @ nHt-15, 48 BUTTON if( lExcel, 'Excel', 'Calc' ) SIZE 35,11 PIXEL OF oDlg ;
      ACTION ( if ( lExcel, ExpToExcel(oBrw,oDlg), oBrw:ToCalc() ) )
      //ACTION ( if ( lExcel, oBrw:ToExcel(), oBrw:ToCalc() ) )
 

Luego agregas al .prg las siguientes funciones:

Code: Select all

//---------------------------------------------------------// FranciscoA Ago/19/2019

static function ExpToExcel(oBrw,oDlg)

MsgMeter( { |oMeter, oText, oDlg, lEnd | ;
            Exp1ToExcel( oBrw, oMeter, oText, oDlg, @lEnd ) } )

Return nil
 
//---------------------------------------------------------// FranciscoA Ago/19/2019
static function Exp1ToExcel( oBrw, oMeter, oText, oDlg, lEnd )

   oBrw:ToExcel( { |n,t| oMeter:nTotal := t, ;
                         oMeter:Set( n ), ;
                         oText:SetText( Str(n) + '/' + Str(t) ), ;
                         oDlg:Update(), .t. } )

return nil

 

Pruebalo y comentas.

Saludos.

[FranciscoA]

Asi la uso:

Code: Select all

static function Exp2Xls_2_ProgressB()

   local oDlg, oBrw

   DBUSEAREA(.T.,,"FACTURAS","FACTU",.T.)

   MY_XBrowser( "FACTU", "MOVIMIENTO DE FACTURAS" )

   FACTU->(DBCLOSEAREA())

Return nil
 

Saludos.

[Enrrique Vertiz]

Saludos Francisco

Gracias probare y te aviso ...