Array fügt man über Zwischenablage ein ... hier meine Exportfunktion einer DBF, bei dir brauchst das Array ja nicht mehr erzeugen, nur in cTxt übersetzen
Code: Alles auswählen
*-------------------------------------------------------------------------------------
function doExportToXLS(oExcel,cXLS)
LOCAL oBook, oSheet, nCol,nRow, nAltPos
LOCAL nAnz, nStartRec, nEndeRec, nAnzRec, cTxt, cFName, cZei
LOCAL aVarToExcel, cType, x, xMax, oClipBoard, nOffsetDataRow, aDateColumns,aTextColumns
oExcel:visible := .F.
set cursor off
// Feldnamen ermitteln"
xMax := FCount()
// Feldnamen und Codeblock der Umsetzung einmal ermitteln
cFName := ""
nOffsetDataRow := 0 // keine automatisch gesetzten linken Spalten
aDateColumns := {}
aTextColumns := {}
aVarToExcel := Array(xMax)
for x := 1 to xMax
cFName += upper(fieldname(x))+chr(9)
cType := valtype(fieldget(x))
do case
case cType="D"
aVarToExcel[x] := {|dVar|iif(empty(dVar),"",ntrim(D2Excel(dVar)))}
aadd(aDateColumns,x+nOffsetDataRow)
case cType="C"
aVarToExcel[x] := {|cVar|alltrim(cVar)}
aadd(aTextColumns,x+nOffsetDataRow)
case cType="M"
aVarToExcel[x] := {|mVar|Memo2Line(mVar)}
case cType="N"
aVarToExcel[x] := {|nVar|strTran(str(nVar),".",",")}
case cType="L"
aVarToExcel[x] := {|lVar|iif(lVar,"J","N")}
// andere führen zum Fehler
endcase
next
nAnzRec := 50000
nStartRec := 1
nEndeRec := 0
DbGoTop()
oBook := oExcel:workbooks:Add()
oSheet := oBook:ActiveSheet
oSheet:delete()
oSheet := oBook:ActiveSheet
oSheet:delete()
oSheet := oBook:ActiveSheet
// Clipboard-Objekt erzeugen
oClipBoard := XbpClipBoard():new():create()
nRow := row()
nCol := col()+5
@ nRow,nCol say "Bitte warten ... %"
nCol += 17
nAltPos := 0
do while ! eof()
nEndeRec := nStartRec + nAnzRec -1
// in die erste Zeile kommen die Feldnamen
cTxt := cFName+CRLF
// Unten sollen dann die RecNo() stehen
oSheet:name := ntrim(nStartRec)+" - "+ntrim(min(nEndeRec,lastrec()))
for nStartRec := nStartRec to nEndeRec
if eof()
exit
endif
if nAltPos < DbPosition() // gibt ein ruhigeres Bild
nAltPos := DbPosition()
@nRow,nCol say nAltPos picture "999"
endif
cZei := "" // keine automatisch gesetzten linken Spalten
for x := 1 to xMax
cZei += eval(aVarToExcel[x],fieldget(x))+TAB
next
cTxt += cZei + CRLF
dbskip()
next
oClipBoard:Open()
if ! oClipBoard:Clear()
msgbox("Zwischenablage konnte nicht gelöscht werden !"+chr(13)+;
"Das kann zu Problemen beim PASTE führen, notfalls Rechner neu starten","Fehler bei oCB:Clear()")
endif
oClipBoard:SetBuffer(cTxt)
oClipBoard:Close()
@nRow,nCol+6 say " -> PASTE " color "w+/g"
aeval(aDateColumns, {|nCol| oSheet:Columns(nCol):NumberFormat := "TT.MM.JJJJ"})
aeval(aTextColumns, {|nCol| oSheet:Columns(nCol):NumberFormat := "@"})
oSheet:Cells(1,1):select()
oSheet:Paste()
oSheet:Cells(1,1):select()
@nRow,nCol+6 say space(10)
oExcel:visible := .T.
oSheet:Columns("A:ZZ"):AutoFit()
oSheet:Rows(1):Font:Bold := .t.
oExcel:visible := .F.
if ! eof()
oBook:Sheets:Add(,oSheet)
oSheet := oBook:ActiveSheet
endif
enddo
@nRow,nCol say 100 picture "999"
oExcel:visible := .T.
oBook:SaveAs(cXLS,xlWorkbookNormal)
/*
neues Dateiformat von Excel ab 2007 : xlOpenXMLWorkbook
xlOpenXMLWorkbook 51 Open XML Workbook
*/
oBook:close()
RETURN NIL
Die Funktion war nötig, weil früher die Zeilenanzahl nicht ausreichte in Excel.