修改的一个导出DataSet到xls的单元Word格式.docx

资源描述

修改的一个导出DataSet到xls的单元Word格式.docx

《修改的一个导出DataSet到xls的单元Word格式.docx》由会员分享，可在线阅读，更多相关《修改的一个导出DataSet到xls的单元Word格式.docx（23页珍藏版）》请在冰豆网上搜索。

修改的一个导出DataSet到xls的单元Word格式.docx

TSetOfAtribut;

varFAtribut:

arrayofbyte）;

protected

procedureWriteBOF;

procedureWriteEOF;

procedureWriteDimension;

public

maxCols,maxRows:

Word;

//addby角落的青苔@2005/05/18

procedureCellInteger（vRow,vCol:

word;

aValue:

Integer;

vAtribut:

TSetOfAtribut=[]）;

procedureCellDouble（vRow,vCol:

double;

procedureCellStr（vRow,vCol:

String;

procedureWriteField（vRow,vCol:

Field:

TField）;

constructorCreate（vFileName:

string;

constvMaxCols:

Integer=100;

constvMaxRows:

Integer=65534）;

destructorDestroy;

override;

end;

procedureDataSetToXLS（ds:

TDataSet;

fname:

String）;

//AddBy角落的青苔@2005/05/13//只能导出最多65536条记录

procedureDBGridToXLS（Grid:

TDBGrid;

bSetFieldName:

Boolean;

CallFunc:

TExportXls_CallBackProc;

bAskForStop:

Boolean=True）;

//AddBy角落的青苔@2005/05/19

//突破xls单页65536行的限制，把数据分成数页

functionDBGridToXlsEx（Grid:

constbAskForStop:

Boolean=True;

constbNeedUnite:

Boolean=True）:

//将数个XLS合并成一个（分页），必须保证Path最后无'

或'

，实际已经做成线程，以免程序无响应

procedureUniteSeveralXLSToOne（constTmpFlag,Path,FileName:

String;

constiStart,iEnd:

Integer）;

//procedureStringGridToXLS（grid:

TStringGrid;

var

G_UserCmd:

TUserCommand;

G_XLSWriterIsRuning:

Boolean;

//是否有XLSWriter实例在运行，因为G_UserCmd是全局变量，防止被非法刷新

implementation

const

{BOF}

CBOF=$0009;

BIT_BIFF5=$0800;

BOF_BIFF5=CBOForBIT_BIFF5;

{EOF}

BIFF_EOF=$000a;

{Documenttypes}

DOCTYPE_XLS=$0010;

{Dimensions}

DIMENSIONS=$0000;

CXlsBof:

array[0..5]ofWord=（$809,8,0,$10,0,0）;

CXlsEof:

array[0..1]ofWord=（$0A,00）;

CXlsLabel:

array[0..5]ofWord=（$204,0,0,0,0,0）;

CXlsNumber:

array[0..4]ofWord=（$203,14,0,0,0）;

CXlsRk:

array[0..4]ofWord=（$27E,10,0,0,0）;

CXlsBlank:

array[0..4]ofWord=（$201,6,0,0,$17）;

//合并数个Xls为一个多页面xls的线程

TUniteSeveralXLSToOneThread=class（TThread）

TmpFlag:

Path:

FileName:

iStart:

Integer;

iEnd:

mCompleted:

procedureExecute;

override;

constructorCreate（const_TmpFlag,_Path,_FileName:

const_iStart,_iEnd:

//根据StrFlags在FullStr最后出现的位置，将FullStr分割成两部分，取得的两部分均不包含StrFlags

procedureSplitStrToTwoPartByLastFlag（constFullStr,StrFlags:

varstrLeft,strRight:

variPos:

begin

iPos:

=LastDelimiter（StrFlags,FullStr）;

strLeft:

=Copy（FullStr,1,iPos-1）;

strRight:

=Copy（FullStr,iPos+1,Length（FullStr）-iPos）;

end;

constructorTUniteSeveralXLSToOneThread.Create（const_TmpFlag,_Path,_FileName:

inheritedCreate（True）;

=_TmpFlag;

=_Path;

=_FileName;

=_iStart;

=_iEnd;

=False;

Resume（）;

destructorTUniteSeveralXLSToOneThread.Destroy;

inherited;

procedureTUniteSeveralXLSToOneThread.Execute;

_HeadLetterOfXls:

Array[1..52]ofString//注意这里只定义了52列，需要增加就自己动手，最多256列

=（'

AA'

AB'

AC'

AD'

AE'

AF'

AG'

AH'

AI'

AJ'

AK'

AL'

AM'

AN'

AO'

AP'

AQ'

AR'

AS'

AT'

AU'

AV'

AW'

AX'

AY'

AZ'

）;

_XlsResCaption='

FKULWJS_SKSLA_892x_RES'

_XlsTmpCaption='

FKULWJS_SKSLA_892x_TMP'

XlsAppRes,XlsAppTmp:

TExcelApplication;

wkBookRes,wkBookTmp:

_WorkBook;

wkSheetRes,wkSheetTmp:

_WorkSheet;

LCID_Res,LCID_Tmp:

Pos_LeftTop,Pos_RightBottom:

//Xls中左上、右下位置

XlsAppHwnd:

THandle;

bDontSave:

StrName,StrExt:

//文件名及扩展名

FreeOnTerminate:

=True;

ifTerminatedthenExit;

SplitStrToTwoPartByLastFlag（FileName,'

StrName,StrExt）;

try

Screen.Cursor:

=crHourGlass;

XlsAppRes:

=TExcelApplication.Create（Nil）;

withXlsAppResdo

begin

Connect;

Visible[0]:

=False;

LCID_Res:

=GetUserDefaultLCID（）;

DisplayAlerts[LCID_Res]:

Caption:

=_XlsResCaption;

wkBookRes:

=WorkBooks.Add（EmptyParam,LCID_Res）;

XlsAppTmp:

withXlsAppTmpdo

LCID_Tmp:

DisplayAlerts[LCID_Tmp]:

=_XlsTmpCaption;

fori:

=iStarttoiEnddo

ifi&

lt;

=3thenwkSheetRes:

=wkBookRes.Sheets[i]as_WorkSheet

else

wkBookRes.Sheets.Add（EmptyParam,wkSheetRes,1,EmptyParam,LCID_Res）;

wkSheetRes:

=wkBookRes.Sheets[i]as_WorkSheet;

wkBookTmp:

=XlsAppTmp.WorkBooks.Open（Path+'

+TmpFlag+IntToStr（i）+FileName,EmptyParam,EmptyParam,

EmptyParam,EmptyParam,EmptyParam,EmptyParam,

EmptyParam,EmptyParam,LCID_Tmp）;

Pos_LeftTop:

A1'

wkSheetTmp:

=XlsAppTmp.ActiveSheetas_WorkSheet;

Pos_RightBottom:

=_HeadLetterOfXls[wkSheetTmp.UsedRange[LCID_Tmp].Columns.Count]+IntToStr（wkSheetTmp.UsedRange[LCID_Tmp].Rows.Count）;

XlsAppTmp.Range[Pos_LeftTop,Pos_RightBottom].Copy（EmptyParam）;

wkSheetRes.Activate（LCID_Res）;

wkSheetRes.Range[Pos_LeftTop,Pos_RightBottom].Select;

wkSheetRes.Paste（EmptyParam,EmptyParam,LCID_Res）;

wkSheetRes.Columns.AutoFit;

wkSheetRes.Range['

].Select;

wkSheetRes.Name:

=StrName+'

+IntToStr（i）;

finally

（wkBookRes.Sheets[1]as_WorkSheet）.Activate（LCID_Res）;

wkBookRes.Close（Not（bDontSave）,Path+'

+FileName,EmptyParam,LCID_Res）;

XlsAppRes.Quit;

XlsAppRes.Disconnect;

//杀死未关闭的Excel进程

XlsAppHwnd:

=FindWindow（Nil,_XlsResCaption）;

ifXlsAppHwnd&

gt;

0thenSendMessage（XlsAppHwnd,WM_CLOSE,0,0）;

//wkBookTmp.Close（False,Path+'

+TmpFlag+IntToStr（i）+FileName,EmptyParam,LCID_Tmp）;

XlsAppTmp.Quit;

XlsAppTmp.Disconnect;

=FindWindow（Nil,_XlsTmpCaption）;

//TerminateProcess（XlsAppHwnd,0）;

=crDefault;

varc,r:

xls:

TXLSWriter;

=TXLSWriter.create（fname）;

ifds.FieldCount&

xls.maxcolsthen

xls.maxcols:

=ds.fieldcount+1;

xls.writeBOF;

xls.WriteDimension;

forc:

=0tods.FieldCount-1do

xls.Cellstr（0,c,ds.Fields[c].DisplayLabel）;

=1;

ds.first;

while（notds.eof）and（r&

=xls.maxrows）dobegin

ifds.Fields[c].AsString&

then

xls.WriteField（r,c,ds.Fields[c]）;

inc（r）;

ds.next;

xls.writeEOF;

xls.free;

Boolean=True）;

varc,r,i:

nTotalCount,nCurrentCount:

bDontSave:

Grid.DataSource.DataSet.DisableControls;

ifGrid.FieldCount&

=Grid.fieldcount+1;

try

ifbSetFieldNamethen

=0toGrid.FieldCount-1do

xls.Cellstr（0,c,Grid.Fields[c].FieldName）;

=2;

end

elser:

xls.Cellstr（r-1,c,Grid.Fields[c].DisplayLabel）;

nTotalCount:

=Grid.DataSource.DataSet.RecordCount;

nCurrentCount:

=0;

Grid.DataSource.DataSet.First;

=0tonTotalCount-1do

Application.ProcessMessages;

ifr&

xls.maxrowsthenRaiseException.Create（'

导出的数据超过'

+IntToStr（xls.maxrows）+'

条记录，操作失败！

Inc（nCurrentCount）;

CallFunc（nCurrentCount/nTotalCount）;

ifG_UserCmd=UserStopthen

ifbAskForStopthen

caseApplication.MessageBox（'

您停止了导出数据，请问需要保存吗？

（选择“取消”继续导出）'

询问'

MB_YESNOCANCEL）of

IDYES:

Break;

IDNO:

RaiseException.Create（'

用户停止，导出数据未保存！

IDCANCEL:

G_UserCmd:

=UserDoNothing;

elsebeginbDontSave:

if（Grid.Fields[c].AsString&

）then

xls.WriteField（r,c,Grid.Fields[c]）;

Grid.DataSource.DataSet.Next;

ifbDontSavethenDeleteFile（fname）;

Grid.DataSource.DataSet.EnableControls;

//将数个XLS合并成一个（分页）

Array[1..52]ofString

展开阅读全文