修改的一个导出DataSet到xls的单元Word格式.docx
- 文档编号:17510066
- 上传时间:2022-12-06
- 格式:DOCX
- 页数:23
- 大小:21.42KB
修改的一个导出DataSet到xls的单元Word格式.docx
《修改的一个导出DataSet到xls的单元Word格式.docx》由会员分享,可在线阅读,更多相关《修改的一个导出DataSet到xls的单元Word格式.docx(23页珍藏版)》请在冰豆网上搜索。
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列
=('
A'
'
B'
C'
D'
E'
F'
G'
H'
I'
J'
K'
L'
M'
'
N'
O'
P'
Q'
R'
S'
T'
U'
V'
W'
X'
Y'
Z'
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:
i:
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);
r:
=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);
r:
=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
AN
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 修改 一个 导出 DataSet xls 单元
![提示](https://static.bdocx.com/images/bang_tan.gif)