Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Spreading a cursor across and down a sheet
Message
From
29/07/2003 07:43:05
Cetin Basoz
Engineerica Inc.
Izmir, Turkey
 
 
To
29/07/2003 06:29:05
Geert Van Snik
Zorgned Automatisering Bv
Wageningen, Netherlands
General information
Forum:
Visual FoxPro
Category:
COM/DCOM and OLE Automation
Miscellaneous
Thread ID:
00814457
Message ID:
00814459
Views:
11
>I need to create one sheet with two 'tables' on them. The data for the table is coming from only one cursor. I use the COPY TO ... TYPE XL5 from within FoxPro. I specify all required fields and Excel shows the each record in one row.
>
>However I need to break up the rows, and repeat the first column from the first 'table' in the second 'table'
>A coworker suggested a copy/cut-paste in the worksheet, this might work, I haven't tried it yet. I have a feeling that I should be able to spread the contents over ranges of cells, but I don't know how.
>
>Can anyone give me any pointers?

A sample :
Clear All
* Create a test cursor
Create Cursor testcursor ;
  (Rcno i,cType c(10), nType i, dType d)
Rand(-1)
For ix = 1 To 20000 && Create 20000 recs cursor
  Insert Into testcursor Values ;
    (Recco()+1,Sys(2015), Int(Rand()*1000), Date()-Int(Rand()*100))
Endfor

lnTotal = Reccount()
lcHeader = ''
For ix=1 To Fcount()
  lcHeader = lcHeader + Iif(Empty(lcHeader),'',Chr(9))+Proper(Field(ix))
Endfor
lcHeader = lcHeader + Chr(13)+Chr(10)
lnPerCol = 3000 && Put 3000 per set
lnPasses = Ceiling(lnTotal / lnPerCol)


Wait Window Nowait "Pls wait sending data to Excel..."
Start = Seconds()
oExcel = Createobject("Excel.application")
With oExcel
  .workbooks.Add && Add a new workbook
  For ix=1 To lnPasses
    InsertGroup(ix, lnPerCol, lcHeader)
  Endfor
  With .ActiveWorkBook.ActiveSheet
    .UsedRange.Columns.Autofit
    .Range('A1').Activate
  Endwith
  .Visible = .T.
Endwith
? "Total Elapsed : ",Seconds() - Start

Function InsertGroup
  Lparameters tnColNumber, tnPerCol, tcHeader
  Local lnPasteStart, lcTempFile, lcRange
  lnPasteStart = ( tnColNumber - 1 ) * tnPerCol + 1

  * Leave 2 empty columns between sets
  lcRange = _GetChar( (tnColNumber-1) * (Fcount() + 2) + 1)+'1'

  lcTempFile = Sys(2015)+".txt"
  Copy To (lcTempFile) Delimited With Tab ;
    For Between(Recno(),lnPasteStart,lnPasteStart+tnPerCol-1)
  _Cliptext = tcHeader+Filetostr(lcTempFile)
  Erase (lcTempFile)
  With oExcel.ActiveWorkBook.ActiveSheet
    .Range(lcRange).PasteSpecial()
    _Cliptext = "" && Empty clipboard
  Endwith

* Return A, AA, BC etc noation for nth column
Function _GetChar
  Lparameters tnColumn && Convert tnvalue to Excel alpha notation
  If tnColumn = 0
    Return ""
  Endif
  If tnColumn <= 26
    Return Chr(Asc("A")-1+tnColumn)
  Else
    Return _GetChar(Int(Iif(tnColumn % 26 = 0,tnColumn - 1, tnColumn) / 26)) + ;
      _GetChar((tnColumn-1)%26+1)
  Endif
Cetin
Çetin Basöz

The way to Go
Flutter - For mobile, web and desktop.
World's most advanced open source relational database.
.Net for foxheads - Blog (main)
FoxSharp - Blog (mirror)
Welcome to FoxyClasses

LinqPad - C#,VB,F#,SQL,eSQL ... scratchpad
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform