| iamdream
45773
|
2013/4/12 10:27:22 |
最近将老代码升级到Delphi2010时将导出到Excel的代码整理了一下，现在可以支持D5~XE3了：DataSet分页导出到Excel(支持超过65536条记录)<http://dreamisx.blog.163.com/blog/static/115004839201331110398897/>
好久没看评论，这次正好总结一下：
1.不能设置类range的ColumnWidth属性
答：貌似是ColumnWidth超过255了，只要确保ColumnWidth不超过255即可，我这次最新整理的代码增加了检查；
2.导出的字符型字段数据都变成64
答：原先的代码只支持Ansi版本的Delphi，如果在Delphi2010之类的Unicode版本中用NumberFormatLocal := '@'来设置为文本型，则会变成64('@'的ASCII码)，只要改成NumberFormatLocal := AnsiChar('@')就可以了；
3.之前的代码未处理Memo及Blob字段，这次整理也做了改进。 |
| songyang
41383
|
2011/3/18 10:47:37 |
| 导出的字符型字段数据都变成64 |
| xueguangjin
39737
|
2010/3/21 22:24:10 |
请求高人相助！
我问题太多！ |
| suiyunonghen
37538
|
2009/5/22 0:01:08 |
修改了一下，我也。
procedure SaveDbGridAsExcel(Grid: TDBGrid;const FileName,title: string;
const MaxPageRowCount: Integer = 65535;const ShowProgress: Boolean = True);
const
MAX_VAR_ONCE = 1000; //一次导出的条数
var //返回导出记录条数
Excel, varCells: Variant;
MySheet, MyCells, Cell1, Cell2, Range: OleVariant;
iRow, iCol, iSheetIdx, iVarCount, iCurRow: integer;
CurPos: TBookmark;
ProgressForm: TForm;
Prompt: TLabel;
progressBar: TProgressBar;
Panel : TPanel;
Button : TButton;
procedure ReSetObjEvent(OldEventAddr: pointer;NewEventValue: pointer;ReSetObject: TObject);
begin
TMethod(OldEventAddr^).Code := NewEventValue;
TMethod(OldEventAddr^).Data := ReSetObject;
end;
procedure ButtonClick(BtnObject: TObject;Sender: TObject);
begin
TComponent(BtnObject).Tag := Integer(MessageBox(Application.Handle,
'真的要终止数据的导出吗？','确认',
MB_OKCANCEL + MB_ICONINFORMATION) = IDOK);
end;
procedure CreateProgressForm;
begin
ProgressForm := TForm.Create(nil);
With ProgressForm do
begin
Font.Name := '宋体';
Font.Size := 10;
BorderStyle := bsNone;
Width := 280;
Height := 120;
BorderWidth := 1;
Color := clBackground;
Position := poOwnerFormCenter;
end;
Panel := TPanel.Create(ProgressForm);
with Panel do { Create Panel }
begin
Parent := ProgressForm;
Align := alClient;
BevelInner := bvNone;
BevelOuter := bvNone;
Caption := '';
end;
Prompt := TLabel.Create(Panel);
with Prompt do { Create Label }
begin
Parent := Panel;
Left := 20;
Top := 25;
Caption := '正在启动Excel，请稍候……';
end;
progressBar := TProgressBar.Create(panel);
with ProgressBar do { Create ProgressBar }
begin
Step := 1;
Parent := Panel;
Smooth := true;
Left := 20;
Top := 50;
Height := 18;
Width := 260;
end;
Button := TButton.Create(Panel);
with Button do { Create Cancel Button }
begin
Parent := Panel;
Left := 115;
Top := 80;
Caption := '关闭';
end;
ReSetObjEvent(@@Button.OnClick,@ButtonClick,Button);
ProgressForm.FormStyle := fsStayOnTop;
ProgressForm.Show;
ProgressForm.Update;
end;
begin
if (Grid.DataSource <> nil) and
(Grid.DataSource.DataSet <> nil) and
Grid.DataSource.DataSet.Active then
begin
Grid.DataSource.DataSet.DisableControls;
CurPos := Grid.DataSource.DataSet.GetBookmark;
Grid.DataSource.DataSet.First;
try
if ShowProgress then
begin
CreateProgressForm;
Button.Tag := 0;
end;
Excel := CreateOleObject('Excel.Application');
Excel.WorkBooks.Add;
Excel.Visible := False;
except
Application.Messagebox('Excel 没有安装!','操作提示', MB_IConERROR + mb_Ok);
Screen.Cursor := crDefault;
Grid.DataSource.DataSet.GotoBookmark(CurPos);
Grid.DataSource.DataSet.FreeBookmark(CurPos);
Grid.DataSource.DataSet.EnableControls;
if ProgressForm <> nil then
ProgressForm.Free;
exit;
end;
if Grid.DataSource.DataSet.RecordCount <= MAX_VAR_ONCE then
iVarCount := Grid.DataSource.DataSet.RecordCount
else iVarCount := MAX_VAR_ONCE;
varCells := VarArrayCreate([1, iVarCount,1,Grid.FieldCount],varVariant);
iSheetIdx := 1;
iRow := 0;
if ShowProgress then
begin
ProgressBar.Position := 0;
Prompt.Caption := '请等待，正在导出数据……';
ProgressBar.Max := Grid.DataSource.DataSet.RecordCount;
end;
while (not Grid.DataSource.DataSet.Eof and not ShowProgress) or
(not Grid.DataSource.DataSet.Eof and ShowProgress and (Button.Tag = 0)) do
begin
if (iRow = 0) or (iRow > MaxPageRowCount + 1) then
begin
if iSheetIdx <= Excel.WorkBooks[1].WorkSheets.Count then
MySheet := Excel.WorkBooks[1].WorkSheets[iSheetIdx]
else
MySheet := Excel.WorkBooks[1].WorkSheets.Add(NULL, MySheet);//加在后面
MySheet.Name := Title + IntToStr(iSheetIdx);
MyCells := MySheet.Cells;
Inc(iSheetIdx);
//开始新的数据表
iRow := 1;
//写入表头
for iCol := 1 to Grid.FieldCount do
begin
MySheet.Cells[1, iCol] := Grid.Columns[iCol-1].Title.Caption;
MySheet.Cells[1, iCol].Font.Bold := True;
if (Grid.Fields[iCol - 1].DataType = ftString) or
(Grid.Fields[iCol - 1].DataType = ftWideString) then
//对于“字符串”型数据则设Excel单元格为“文本”型
MySheet.Columns[iCol].NumberFormatLocal := '@';
end;
Inc(iRow);
end;
iCurRow := 1;
while (not Grid.DataSource.DataSet.Eof and not ShowProgress) or
(not Grid.DataSource.DataSet.Eof and ShowProgress and (Button.Tag = 0)) do
begin
for iCol := 1 to Grid.FieldCount do
begin
Application.ProcessMessages;
if Grid.Fields[iCol - 1].IsBlob then
varCells[iCurRow, iCol] := '二进制数据'
else varCells[iCurRow, iCol] := Grid.Fields[iCol-1].AsString;
end;
Inc(iRow);
Inc(iCurRow);
if ShowProgress then
ProgressBar.Position := ProgressBar.Position + 1;
Application.ProcessMessages;
Grid.DataSource.DataSet.Next;
if (iCurRow > iVarCount) or (iRow > MaxPageRowCount + 1) then
begin
Application.ProcessMessages;
Break;
end;
end;
Cell1 := MyCells.Item[iRow - iCurRow + 1, 1];
Cell2 := MyCells.Item[iRow - 1,Grid.FieldCount];
Range := MySheet.Range[Cell1 ,Cell2];
Range.Value := varCells;
MySheet.Columns.AutoFit;
Cell1 := Unassigned;
Cell2 := Unassigned;
Range := Unassigned;
Application.ProcessMessages;
end;
if (ShowProgress and (Button.Tag = 0)) or not ShowProgress then
MySheet.saveas(FileName);
MyCells := Unassigned;
varCells := Unassigned;
Excel.WorkBooks[1].Saved := True;
MySheet.application.quit;
Excel.quit;
Excel := Unassigned;
if CurPos <> nil then
begin
Grid.DataSource.DataSet.GotoBookmark(CurPos);
Grid.DataSource.DataSet.FreeBookmark(CurPos);
end;
Grid.DataSource.DataSet.EnableControls;
if ProgressForm <> nil then
ProgressForm.Free;
end;
end; |
| hongss
37412
|
2009/5/7 12:07:36 |
MyExcel.Visible := True;
MyExcel.WorkBooks[1].Saved := True;
改为
MyExcel.Visible := False;
MyExcel.SaveAs('文件路径名');
Excel还是会打开，而且用SaveAs也存不下来。
用MyExcel.WorkBooks[1].SaveAs也不行…… |
| onionzq
37395
|
2009/5/1 23:44:35 |
| 速度确实挺快的，Mark. |
| wgxis
37347
|
2009/4/27 20:28:05 |
不知道为什么，导出时会显示错误（编译没错误）
Access violation at address 0047D2B1 in module 'warehouse.exe'.Read of address 000000D2
warehouse.exe 是我的项目 |
| zjyn
37201
|
2009/4/13 18:12:11 |
| 不能设置类range的columnwidth属性是什么意思？ |
| longwater
37079
|
2009/4/3 0:39:54 |
| 我的做的系统有18W个客户以前导客户资料要是存成Excel 根本不够，不过我有自己在SQL里实现分开保存，啥时候有空拿这个试试卡 |
| zhoukuanyu
36097
|
2008/11/8 11:47:07 |
| 速度很快 非常感谢 |
| huangbit
35123
|
2008/7/28 23:47:05 |
| 非常感谢您iamdream，解决了困惑我很久的大问题。刚刚测试了，速度很快，而且调用很方便。 |
| aagen
34024
|
2008/5/7 2:40:36 |
学习了啊
支持一下哦
多谢 |
| iamdream
32836
|
2008/1/21 22:51:14 |
| 众人拾柴火焰高啊! 最新发现,如何用于导出Memo等字段的内容时,一旦Memo字段的内容一多或复杂(不能肯定是这个原因)就会报OLE Error,所以导出Memo字段内容时还是一格一格输出吧,毕竟难得需要导出大量带Memo字段的数据到Excel的. |
| iamdream
26522
|
2006/10/11 20:07:03 |
| 那你用MyExcel.WorkBooks[1].SaveAs(...)试试。 |
| zlbpolly
26466
|
2006/10/8 12:32:05 |
iamdream 你好！
MyExcel.SaveAs('data.xls');
要保存为Excel文件，这样做报错：
----------
Debugger Exception Notification
----------
Project Project2.exe raised exception class EOleError with message 'Method 'SaveAs' not supported by automation object'. Process stopped. Use Step or Run to continue.
----------
OK Help
---------- |
| iamdream
25506
|
2006/8/17 13:30:46 |
to xue_qy:
最后加一个MyExcel.Quit;就可以使Excel退出. |
| xue_qy
25016
|
2006/7/20 14:54:04 |
非常感谢iamdream，喜欢这种朴素的、实用的技巧。
有个问题，储存完excel文件后，windows内存中的excel进程并没关闭，这时如果要打开excel文件会出错，如何安全关闭excel进程。 |
| iamdream
24358
|
2006/6/17 11:49:05 |
to gmshello:
你将最后的
MyExcel.Visible := True;
MyExcel.WorkBooks[1].Saved := True;
改为
MyExcel.Visible := False;
MyExcel.SaveAs('文件路径名');
就可以了。 |
| gmshello
24260
|
2006/6/13 11:17:38 |
| 能否给个实例使导出的数据保存在指定的文件路径和文件名中但用不显示Excel |
| idoudo
24198
|
2006/6/9 21:38:52 |
问下delphi 方面的问题，我经常遇到这个问题。
我的程序 经常是 在莫个控件后"."下面的提示出不来，（我放到 程序开头时就才有） 一定要自己写出它的属性或方法，（在没提示的情况下）运行时也不会出错的。就是重起了也没用。这是为什么的~~各位。。 |
