procedure TfrmList.SaveToExcel(dg:TDBGrid;ado:TADOQuery);
var
MsExcel,sheet:variant;
dialogSave:TSaveDialog;
i:integer;
s,str:string;
strlist:TStringList;
fExist:boolean;
begin
dialogsave:=TSaveDialog.Create(Application);
dialogsave.Filter:='Excel文件(*.xls) |*.xls';
str:=formatdatetime('yymmddhhmmss',now);
if dialogsave.Execute then
begin
screen.Cursor:=crHourGlass;
//****创建MSEXCEL对象
try
MsExcel:=CreateOleObject('Excel.Application');
except
showmessage('请确定您的计算机是否已正确安装Microsoft Excel ?');
freeandnil(dialogsave);
screen.Cursor:= crDefault;
exit;
end;
try
//****为新工作表命名,默认为当前的日期时间
if InputQuery('输入工作表名称','该类文件允许以多个工作表的形式进行保存,请输入该工作表的名称',str) then
begin
//****以下代码先检测导出的文件是否已存在,如果已存在,则打开并增加一工作表,否则新建
if fileExists(dialogsave.FileName) then
begin
fExist:=true;
msexcel.workbooks.open(dialogsave.FileName); //打开已存在的文件
sheet:=msexcel.worksheets.add; //新增一工作表
end
else
begin
fExist:=false;
msexcel.workbooks.add; //新建一工作簿
sheet:=msexcel.workbooks[1].worksheets[1];
end;
//****以下代码将DBGrid内容复制到粘贴板中
strlist:=Tstringlist.Create;
s:='';
for i:=0 to dg.FieldCount-1 do //将标题行加入字符串S中
s:=s+dg.Fields[i].FieldName+#9;
strlist.Add(S); //将标题行加入至字符串列表strList中
ado.First;
while not ado.Eof do //穷举数据库,并加入字符串列表中
begin
s:='';
for i:=0 to dg.FieldCount-1 do
s:= s+dg.Fields[i].AsString+#9;
strlist.Add(s);
ado.Next;
end;
clipboard.AsText:=strlist.Text; //将字符串列表内容加入到粘贴板
sheet.cells.NumberFormatLocal:='@'; //设置工作表字体格式为文本
sheet.cells.Font.Size:='10'; //设置字体大小
sheet.Paste; //粘贴
sheet.name:=str; //为工作表命名
if fExist then //保存文件
msexcel.workbooks[1].save
else
msexcel.workbooks[1].SaveAs(dialogsave.filename);
showmessage(文件已成功导出至以下位置: '+dialogsave.filename);
end;
except
showmessage(文件不可用,请稍后重试!');
freeandnil(strlist);
msexcel.quit; //退出Excel
msexcel:=Unassigned ; //释放MSEXCEL对象
freeandnil(dialogsave);
screen.Cursor:= crDefault;
exit;
end;
freeandnil(strlist);
msexcel.quit; //退出Excel
msexcel:=Unassigned ; //释放MSEXCEL对象
freeandnil(dialogsave);
screen.Cursor:= crDefault;
end;
end;
本站仅提供存储服务,所有内容均由用户发布,如发现有害或侵权内容,请
点击举报。