HMGforum.com

Code: Select all

#include "minigui.ch"
#include "excel.ch"

Function Main()
   Local cFile := GetFile({{'DBF File','*.dbf'}}, 'DBF File')
   Local a_fields , cAlias

   if empty(cFile)
      Return Nil
   endif
   If ! File( cFile )
      MSGSTOP("File I/O error, cannot proceed")
      Return Nil
   ENDIF

   cAlias :=ALLTRIM(substr(cFile,Rat('\',cFile)+1))
   cAlias :=substr(cAlias,1,len(cAlias)-4)
      
   use &cFile alias &cAlias
   a_fields := {}
   
   for n:=1 to fcount()
      aadd( a_fields , fieldname( n ) )
   next

   Define Window winMain ;
      at 0, 0 ;
      width 470 ;
      height 350 ;
      title cFile ;
      main ;
      nomaximize
         
   	@ 10, 10 button cmdShowexcel caption "Show in Excel" ;
   		action ShowExl(cAlias, a_fields, a_fields, cFile)
   end window
   
   winMain.center
   winMain.activate
 	return nil
   
   

function ShowExl(cAlias, aFldnm, aPrompt, mHeading)
private oExcel, nRow, nStartRow, mPrevRow, cMemo, mesg, i, mTemp

   oExcel = CREATEOBJECT( "Excel.Application" )
   oExcel:WorkBooks:Add()
   oSheet = oExcel:ActiveSheet
   //oExcel:ActiveWindow:DisplayGridlines = .f.
   nRow := 1

   nRow++
   with object oSheet
      for i = 1 to len(aPrompt)
         :Cells(nRow, i):Value = aPrompt[i]
      next
   end
   nRow++

   select &cAlias
   nStartRow = nRow
   cMemo = ""

   do while inkey() != 27 .and. !eof()



      FOR i = 1 TO len(aFldnm)
        mTemp = eval(fieldblock(aFldnm[i]))
         do case
            case valtype(mTemp) $ "CM"
               cMemo += alltrim(mTemp)
            case valtype(mTemp) = "D"
               cMemo += ExcelDt(mTemp)
            case valtype(mTemp) = "N"
               cMemo += ltrim(str(mTemp, 12, 2))
            case valtype(mTemp) = "L"
               cMemo += iif(mTemp, "Yes", "No")
         endcase
         cMemo += chr(9)
      NEXT
      
      cMemo += chr(10)

      mPrevrow = nRow
      nRow++
      
      skip
      
      if (inkey() != 27 .and. !eof()) .or. mod(nRow, 1000) = 0
         CopyToClipboard( cMemo )
         oSheet:Cells( nStartRow, 1 ):Select()
         oSheet:paste()
         nStartRow := nRow
         cMemo := ''
      ENDIF         

      select &cAlias
   enddo

   oSheet:Columns( "A:"+chr(asc("A")+len(aFldnm))):AutoFit()
   if mHeading <> NIL
      oSheet:Cells( 1, 1 ):Value = mHeading
   endif
   oSheet:Range("A1"):select()

   oExcel:Visible = .T.
   return nil

   
   
function CopyToClipboard
	param cTekst
	#define HB_GTI_CLIPBOARDDATA 15
	hb_gtInfo( HB_GTI_CLIPBOARDDATA, cTekst )
	return

function ExcelDt(mDt)
   return (ltrim(str(day(mDt)))+"-"+left(cmonth(mDt), 3)+"-"+str(year(mDt), 4))

   
function ExcelBorder(oSheet, col1, row1, col2, row2)
   local mRange
   mRange = col1+ltrim(str(row1))+":"+col2+ltrim(str(row2))
   oSheet:Range(mRange):Borders(xlEdgeTop):LineStyle = xlContinuous
   oSheet:Range(mRange):Borders(xlEdgeLeft):LineStyle = xlContinuous
   oSheet:Range(mRange):Borders(xlEdgeBottom):LineStyle = xlContinuous
   oSheet:Range(mRange):Borders(xlEdgeRight):LineStyle = xlContinuous
   return