var
TempFileName:string;
TotalRecords:integer;
FieldCounts,i:integer;
begin
FieldCounts:=0;
for i:=0 to dbgrid1.Columns.Count-1 do
begin
if dbgrid1.Columns.visible then
inc(FieldCounts);
end;
if FieldCounts > 26 then
begin
Application.MessageBox('字段数过多不能进行数据转出,请将字段数控制在26以内!','提示信息',MB_ICONINFORMATION + mb_ok+mb_iconInformation);
Exit;
end;
TotalRecords:=strtoint(lblDj.caption);
SaveDialog.Filter:='Microsoft Excel Files (*.xls)|*.XLS';
if SaveDialog.Execute then
begin
if Pos('.XLS', UpperCase(SaveDialog.FileName)) = 0 then
TempFileName := SaveDialog.FileName + '.XLS'
else
TempFileName := SaveDialog.FileName;
if FileExists(TempFileName) then
begin
if Application.MessageBox('文件已经存在,是否覆盖保存?','提示信息',MB_ICONINFORMATION + MB_OKCANCEL) = IDOK then
begin
DeleteFile(TempFileName);
SaveExcel(TempFileName,dbgrid1,TotalRecords);
end;
end
else
SaveExcel(TempFileName,dbgrid1,TotalRecords);
end;
end;
procedure TfrmBdysgl.SaveExcel(FileName : string; dbgClientFind : TDBGrid; TotalRecord:integer);
var
iCol, iRow ,iCount : integer; //循环变量,控制Excel表中当前行、列
Excel: Variant;
WorkBook, WorkSheet : variant; //返回当前的Excel对象
year,month,day:string;
begin
//若数据集的字段数大于26,则不允许数据转出
//原因是Excel中1-26列利用相应大写字母表示,从27列开始利用两个字母表示,不好控制,且出现的几率不大
{if dbgClientFind.FieldCount > 26 then
begin
Application.MessageBox('字段数过多不能进行数据转出,请将字段数控制在26以内!','提示信息',MB_ICONINFORMATION + mb_ok+mb_iconInformation);
Exit;
end; }
//创建Excel对象
try
Excel := CreateOLEObject('Excel.Application');
except
application.messagebox('没有安装Excel或者Excel安装不正确,不能进行数据转出','提示信息',64);
exit;
end;
dbgClientFind.DataSource.DataSet.DisableControls;
try
//生成Excel对象的实例
WorkBook := Excel.WorkBooks.Add;
WorkSheet := WorkBook.WorkSheets.Add;
//获得当前数据集的记录数,为进度条的生成产生条件
//将数字的输入当作文本存储,否则数字输入的前导零不能存储,即0012只能存为12.
WorkSheet.Range['A1:Z'+IntToStr(TotalRecord+1)].NumberFormatLocal := '@';
//往Excel表中添加字段名
iCount:=1;
for iCol := 0 to dbgClientFind.Columns.Count-1 do
//若字段的Visible属性为True,则添加到Excel表中
if dbgClientFind.columns[iCol].visible then
begin
//Excel表中的第一行
WorkSheet.Cells[1,iCount].Value := dbgClientFind.Columns[iCol].Title.Caption;
//设置标题内容居中
WorkSheet.Cells[1,iCount].HorizontalAlignment := 3;
inc(iCount);
end;
//开始数据的转入
dbgClientFind.DataSource.DataSet.first;
//从第二行开始,第一行存储字段名
iRow:=2;
while not dbgClientFind.DataSource.DataSet.EOF do
begin
iCount:=0;
for iCol := 0 to dbgClientFind.Columns.Count - 1 do
begin
if dbgClientFind.columns[iCol].visible then
begin
if (iCol=7) or (iCol=6) then WorkSheet.Range[Chr(65+iCount)+IntToStr(iRow)].Value :=strtofloat(dbgClientFind.columns[iCol].field.DisplayText)
else if (iCol=9) or (iCol=8) or (icol=10) or (icol=11) then
begin
year:=copy(dbgClientFind.columns[iCol].field.DisplayText,1,4);
month:=copy(dbgClientFind.columns[iCol].field.DisplayText,5,2);
day:=copy(dbgClientFind.columns[iCol].field.DisplayText,7,2);
WorkSheet.Range[Chr(65+iCount)+IntToStr(iRow)].Value :=year+'年'+month+'月'+day+'月';
end
else WorkSheet.Range[Chr(65+iCount)+IntToStr(iRow)].Value :=dbgClientFind.columns[iCol].field.DisplayText;
inc(iCount);
end;
end;
//控制进度条的显示
inc(iRow);
//下一条记录
dbgClientFind.DataSource.DataSet.Next;
end;
//将Excel读入的数据保存到文件中
WorkSheet.SaveAs(FileName);
Application.MessageBox('数据转出成功!','提示信息',MB_ICONINFORMATION + mb_ok+mb_iconInformation);
finally
//关闭Excel
dbgClientFind.DataSource.DataSet.EnableControls;
try
WorkBook.Close(SaveChanges:=False);
except
end;
if not VarIsEmpty(Excel) then
begin
Excel.DisplayAlerts := False;
Excel.Quit;
end;
end;
end;
