FiveTech Software tech support forums

Code: Select all

// --- Impresion del contenido de un browse
static function ImprimeVent(aVent,lExcel)
local oFont,nReg

if lExcel
 if confirma('La generación en Excel se realizará con toda la informaci¢n'+CR_LF+;
             'que contenga la ventana activa.'+CR_LF+;
             '¿Desea continuar?','N')=='N'
  return NIL
 endif
 nReg:=recno()
 CursorWait()
 if lHIJA
  oBROWSEHIJA:ExcelOle(NIL,.t.,NIL,TITVENT)
  oBROWSEHIJA:SetFocus()
  dbgoto(nReg)
 elseif TIPO_VENT=='T'
  oBROWSE:ExcelOle(NIL,.t.,NIL,TITVENT)
  oBROWSE:SetFocus()
  dbgoto(nReg)
 endif
 CursorArrow()
 DespVent(aVent)
 return NIL
else
 if confirma('La impresi¢n se realizará con toda la informaci¢n'+CR_LF+;
             'que contenga la ventana activa.'+CR_LF+;
             '¿Desea continuar?','N')=='N'
  return NIL
 endif
endif
DEFINE FONT oFont NAME "ARIAL" SIZE 0,-8
if lHIJA
 oBROWSEHIJA:Report(TITVENT,.t.,oFont)
else
 oBROWSE:Report(TITVENT,.t.,oFont)
endif
oFont:End()
return NIL
 

Code: Select all

   If lActivate
      oSheet:Range( "A1" ):Select()
      oExcel:Visible := .T.
   EndIf

   ::Reset()
 

Code: Select all

* TSBrowse testing Excel conections - testxls.prg

#include "FiveWin.ch"
#include "\TSBrowse\Include\TSBrowse.ch"

#define CLR_PINK   nRGB( 255, 128, 128)
#define CLR_NBLUE  nRGB( 128, 128, 192)

Static oWnd, oBrw

Request DBFCDX

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

Function Main()

   Local oBmp, oBar, oFont, oFont1, oBrush, oCol, cTitle, lGrid

   If File( "Employee.cdx" )
      FErase( "Employee.cdx" )
   EndIf

   Use Employee Shared New Via "DBFCDX"

   Index On First+Last Tag Name

   Define Font oFont Name "Arial" Size 0, -13
   Define Font oFont1 Name "Arial" Size 0, -13 NESCAPEMENT 900
   Define Brush oBrush Resource "CoverBack"
   Define BitMap oBmp Resource "Selector"
   Define Window oWnd TITLE "TSBrowse/Excel conectivity.    One Click From TSBrowse To Excel   And more..." ;
          Brush oBrush ;
          MENU BuildMenu()

   If Right( FWVERSION, 4 ) >= "7.12"
      Define ButtonBar oBar OF oWnd Size 50, 50 3D 2007
   Else
      Define ButtonBar oBar OF oWnd Size 50, 50 3D
   EndIf

   cTitle := "Database: " + Trim( StrCapFirst( Alias()  ) ) + ".dbf"

   bExtern := {|oSheet| oSheet:Columns( 10 ):Set( "NumberFormat", "#,##0.00" ) }

   Define Button OF oBar Resource "Excel" ;
          Action oBrw:ExcelOle( "Test.xls", .T.,, cTitle,,, bExtern ) ;
          ToolTip "Export Browse to Excel"

   lGrid   := .T.

   Define Button OF oBar Resource "Print" ;
          Action oBrw:Report( cTitle,,,,,,,, lGrid ) ;
          ToolTip "Export Browse to Excel"

   Define Button OF oBar Resource "Exit" ;
          Action oWnd:End() ;
          ToolTip "Exit"

   @ 50, 0 Browse oBrw Alias "Employee" Of oWnd Size oWnd:nWidth, oWnd:nHeight Pixel ;
           Font oFont AutoCols Transparent Selector oBmp Editable

   Add Super Header To oBrw From Column 2 To Column 3 Color CLR_BLUE, { CLR_NBLUE, CLR_WHITE } ;
       Title "Name" 3DLook

   Add Super Header To oBrw FROM Column 4 TO Column 6 Color CLR_BLUE, { CLR_NBLUE, CLR_WHITE } ;
       Title "Address" 3DLook

   With Object oBrw
      :nHeightCell += 4
      :nHeightHead += 3
      :nHeightSuper += 3
      :SetColor( { CLR_HEADF, CLR_HEADB, CLR_FOCUSF, CLR_FOCUSB }, { CLR_BLUE, { CLR_WHITE, CLR_NBLUE, 2 }, ;
                 CLR_BLACK, -1 } )
      :ChangeFont( oFont1, 9, 2 )
      :aColumns[ 9 ]:nHAlign := DT_VERT
   End With

   oWnd:oClient := oBrw

   If Right( FWVERSION, 4 ) >= "7.12"
      Set Message Of oWnd Clock Date Keyboard Noinset 2007
   Else
      SET Message Of oWnd Clock Date Keyboard Noinset
   EndIf

   Activate Window oWnd Maximized

   oFont:End()
   oFont1:End()
   oBrush:End()
   oBmp:End()
   DbCloseAll()

Return Nil

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

Static Function BuildMenu()

   Local oMenu

   If Right( FWVERSION, 4 ) >= "7.12"
      MENU oMenu
   Else
      MENU oMenu
   EndIf

      MENUITEM "TSBrowse"
         MENU
            MENUITEM "Excel" Resource "Excel16" ;
            Action oBrw:ExcelOle( "Test.xls", .T.,, "Here you are" )
            MENUITEM "Exit" Resource "Exit16" ;
            Action oWnd:End()
         ENDMENU
      MENUITEM "&Exit" Action oWnd:End()
      MENUITEM "&Help" Action WinExec( "Start ..\doc\Help.htm", 0 )
   ENDMENU

Return oMenu
 

Code: Select all

* ============================================================================
* METHOD TSBrowse:ExcelOle() Version 9.0 Nov/30/2009
* Requires TOleAuto class
* Many thanks to Victor Manuel Tomás for the core of this method
* ============================================================================

METHOD ExcelOle( cXlsFile, lActivate, oMeter, cTitle, oFont, lSave, bExtern, aColSel, bPrintRow ) CLASS TSBrowse

   Local oExcel, oBook, oSheet, nRow, nCol, uData, nEvery, oRange, cRange, cCell, cLet, nColHead, nVar, ;
         bError, cText, oClip, nStart, aRepl, ;
         nLine  := 1, ;
         nCount := 0, ;
         nRecNo := ( ::cAlias )->( RecNo() ), ;
         nAt    := ::nAt, ;
         aCol := { 26, 52, 78, 104, 130, 156 }, ;
         aLet := { "", "A", "B", "C", "D", "E" }

   Default lActivate := Empty( cXlsFile ), ;
           cTitle    := ""

   Default lSave    := ! lActivate .and. ! Empty( cXlsFile ), ;
           cXlsFile := ""

   CursorWait()

   If ::lSelector
      ::aClipBoard := { OClone( ::aColumns[ 1 ] ), 1, "" }
      ::DelColumn( 1 )
   EndIf

   cLet := aLet[ AScan( aCol, {|e| Len( If( aColSel != Nil, aColSel, ::aColumns ) ) <= e } ) ]

   If ! Empty( cLet )
      nCol := AScan( aLet, cLet ) - 1
      cLet += Chr( 64 + Len( If( aColSel != Nil, aColSel, ::aColumns ) ) - aCol[ Max( 1, nCol ) ] )
   Else
      cLet := Chr( 64 + Len( If( aColSel != Nil, aColSel, ::aColumns ) ) )
   EndIf

   aRepl      := {}
   ::lNoPaint := .F.

   If oMeter != Nil
      oMeter:nTotal := ( ::nLen + 1 ) * Len( ::aColumns ) + 30
      oMeter:Set( 0 )
      oMeter:Refresh()
      nEvery := Max( 1, Int( oMeter:nTotal * .02 ) ) // refresh ometer every 2 %
   EndIf

   If ! Empty( cXlsFile )
      cXlsFile := AllTrim( StrTran( Upper( cXlsFile ), ".XLS" ) )
   EndIf

   cTitle   := AllTrim( cTitle )
   bError   := ErrorBlock( { | x | Break( x ) } )

   Begin Sequence
      oExcel := TOleAuto():New("Excel.Application")
   Recover
      ErrorBlock( bError )
      CursorArrow()
      MsgStop( "No Ole.lib searched", "Error" )
      Return Nil
   End Sequence

   ErrorBlock( bError )

   If oMeter != Nil
      nCount -= 15
      oMeter:Set( nCount )
   EndIf

   oExcel:WorkBooks:Add()
   oBook  := oExcel:Get( "ActiveWorkBook")
   oSheet := oExcel:Get( "ActiveSheet" )

   If oMeter != Nil
      nCount -= 15
      oMeter:Set( nCount )
   EndIf

   ( ::cAlias )->( Eval( ::bGoTop ) )
   cText := ""

   For nRow := 1 To ::nLen

      If nRow == 1
         If ! Empty( cTitle )
            oSheet:Cells( nLine++, 1 ):Value := AllTrim( cTitle )
            oSheet:Range( "A1:" + cLet + "1" ):Set( "HorizontalAlignment", xlHAlignCenterAcrossSelection )
            ++nLine
            nStart := nLine
         Else
            nStart := nLine
         EndIf

         If ! Empty( ::aSuperHead )

            For nCol := 1 To Len( ::aSuperHead )
               nVar := If( ::lSelector, 1, 0 )
               uData := If( ValType( ::aSuperhead[ nCol, 3 ] ) == "B", Eval( ::aSuperhead[ nCol, 3 ] ), ;
                                     ::aSuperhead[ nCol, 3 ] )
               oSheet:Cells( nLine, ::aSuperHead[ nCol, 1 ] - nVar ):Value := uData
               cRange :=  Chr( 64 + ::aSuperHead[ nCol, 1 ] - nVar ) + LTrim( Str( nLine ) ) + ":" + ;
                          Chr( 64 + ::aSuperHead[ nCol, 2 ] - nVar ) + LTrim( Str( nLine ) )
               oSheet:Range( cRange ):Borders():LineStyle := xlContinuous
               oSheet:Range( cRange ):Set( "HorizontalAlignment", xlHAlignCenterAcrossSelection )
            Next

            nStart := nLine ++
         EndIf

         nColHead := 0

         For nCol := 1 To Len( ::aColumns )

            If aColSel != Nil .and. AScan( aColSel, nCol ) == 0
               Loop
            EndIf

            uData := If( ValType( ::aColumns[ nCol ]:cHeading ) == "B", Eval( ::aColumns[ nCol ]:cHeading ), ;
                                  ::aColumns[ nCol ]:cHeading )

            If ValType( uData ) != "C"
               Loop
            EndIf

            uData := StrTran( uData, CRLF, Chr( 10 ) )
            nColHead ++
            oSheet:Cells( nLine, nColHead ):Value := uData

            If oMeter != Nil
               If nCount % nEvery == 0
                  oMeter:Set( nCount )
               EndIf

               nCount ++
            EndIf
         Next

         nStart := ++ nLine
      EndIf

      If bPrintRow != Nil .and. ! Eval( bPrintRow, nRow )
         ::Skip( 1 )
         Loop
      EndIf

      For nCol := 1 To Len( ::aColumns )
         If aColSel != Nil .and. AScan( aColSel, nCol ) == 0
            Loop
         EndIf

         uData := Eval( ::aColumns[ nCol ]:bData )

         If ValType( uData ) == "C" .and. At( CRLF, uData ) > 0
            uData := StrTran( uData, CRLF, "&&" ) // Chr( 10 ) )

            If AScan( aRepl, nCol ) == 0
               AAdd( aRepl, nCol )
            EndIf
         EndIf

         If ::aColumns[ nCol ]:cPicture != Nil
            uData := Transform( uData, ::aColumns[ nCol ]:cPicture )
         EndIf

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

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

         If oMeter != Nil

            If nCount % nEvery == 0
               oMeter:Set( nCount )
            EndIf

            nCount ++
         EndIf
      Next

      ::Skip( 1 )
      cText += Chr( 13 )

      ++nLine
      /*
         Cada 20k volcamos el texto a la hoja de Excel , usando el portapapeles , algo muy rapido y facil ;-)
         Every 20k set text into excel sheet , using Clipboard , very easy and faster.
      */

      IF Len( cText ) > 20000
         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( ::aColumns, { |o| o:cFooting != Nil  } ) > 0

      For nCol := 1 To Len( ::aColumns )

         If ( aColSel != Nil .and. AScan( aColSel, nCol ) == 0 ) .or. ::aColumns[ nCol ]:cFooting == Nil
            Loop
         EndIf

         uData := If( ValType( ::aColumns[ nCol ]:cFooting ) == "B", Eval( ::aColumns[ nCol ]:cFooting ), ;
                      ::aColumns[ nCol ]:cFooting )
         uData := cValTochar( uData )
         uData := StrTran( uData, CRLF, Chr( 10 ) )
         oSheet:Cells( nLine, nCol ):Value := uData
      Next
   EndIf

   If ::lIsDbf
      ( ::cAlias )->( DbGoTo( nRecNo ) )
   EndIf

   ::nAt := nAt

   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 )
   nLIne += If( ! Empty( ::aSuperHead ), 1, 0 )
   cRange := "A" + LTrim( Str( nLine ) ) + ":" + cLet + Alltrim( Str( oSheet:UsedRange:Rows:Count() ) )
   oRange := oSheet:Range( cRange )

   If oFont != Nil // let the programmer to decide the font he wants, otherwise use Excel's default
      oRange:Font:Name := oFont:cFaceName
      oRange:Font:Size := oFont:nSize()
      oRange:Font:Bold := oFont:lBold
   EndIf

   If ! Empty( aRepl )
      For nCol := 1 To Len( aRepl )
         oSheet:Columns( Chr( 64 + aRepl[ nCol ] ) ):Replace( "&&", Chr( 10 ) )
      Next
   EndIf

   If bExtern != Nil
      Eval( bExtern, oSheet, Self )
   EndIf

   oRange:Borders():LineStyle := xlContinuous
   oRange:Columns:AutoFit()

   If ! Empty( aRepl )
      For nCol := 1 To Len( aRepl )
         oSheet:Columns( Chr( 64 + aRepl[ nCol ] ) ):WrapText := .T.
      Next
   EndIf

   If oMeter != Nil
      oMeter:Set( oMeter:nTotal )
   EndIf

   If ::lSelector
      ::InsColumn( ::aClipBoard[ 2 ], ::aClipBoard[ 1 ] )
      ::lNoPaint := .F.
   EndIf

   If ! Empty( cXlsFile ) .and. lSave
      oBook:SaveAs( cXlsFile, xlWorkbookNormal )

      If ! lActivate
         CursorArrow()
         oExcel:Quit()
         ::Reset()
         Return Nil
      EndIf
   EndIf

   CursorArrow()

   If lActivate
      oSheet:Range( "A1" ):Select()
      oExcel:Visible := .T.
   EndIf

   ::Reset()

Return Nil