Y
yangxiufengcom
Unregistered / Unconfirmed
GUEST, unregistred user!
该函数导入Excel速度很快的,
但我想改成导入已做好的Excel模板,那位高手来试,分不再加
这个函数是收藏的,望大家完善
function DBGridExp_EXC(DBGD:TDBgrid):boolean;
var
i,hang,lie:integer;
datas:Variant;
PDBset:^TADODataSet;
st:string;
EApp: TExcelApplication;
EWorkbook: TExcelWorkbook;
EWorksheet: TExcelWorksheet;
// Acolor:OlEVariant;
begin
// Acolor:=OlEVariant('CornSilk');
result:=false;
st:='';
hang:=1;
lie:=1;
PDBset:=@DBGD.DataSource.DataSet;
if PDBset.RecordCount>65530 then
if messageDlg('数据行数可能超过EXCEL最大限制,是否改用文本导出,忽略限制按NO',
mtWarning ,[mbYes,mbNo], 0)=mrYes then exit;
EApp := TExcelApplication.Create(application) ;
EWorkbook:=TExcelWorkbook.Create(application);
EWorksheet:=TExcelWorksheet.Create(application);
try
//--------连接Excel文件----------
EApp.Connect;
EWorkbook.ConnectTo(EApp.Workbooks.Add(emptyparam,0)); //好像这是里
EWorksheet.ConnectTo(EWorkbook.Worksheets[1] as _Worksheet);
for i:=0 to PDBset.FieldCount-1 do
if DBGD.Columns.Visible then
begin
st:=DBGD.Columns.Title.Caption;
{
with EWorksheet.Range[EWorksheet.Cells.Item[hang,lie],
EWorksheet.Cells.Item[hang,lie]] do
begin
Interior.Color:=DBGD.Columns.Title.Color;//clred;//Acolor;
// Font.Color:=DBGD.Columns.Title.Font.tColor;
// font.Size:=DBGD.Columns.Title.Font.Size;
// font.Name:= DBGD.Columns.Title.Font.Name;
//font.FontStyle:=DBGD.Columns.Title.Font.
end; }
EWorksheet.Cells.Item[hang,lie]:=st;
st:=PDBset.Fields.ClassName;
if (st='TDateField') or (st='TDateTimeField') then
with EWorksheet do
Range[cells.Item[2,lie],
cells.Item[PDBset.RecordCount+1,lie]].NumberFormatLocal:=
'[$-F800]dddd, mmmm dd, yyyy';
inc(lie);
end;
datas:=varArrayCreate([1,PDBset.RecordCount,1,lie],varVariant);
PDBset.First;
PDBset.DisableControls;
while not PDBset.Eof do
begin
inc(hang);
lie:=1;
for i:=0 to PDBset.FieldCount-1 do
if DBGD.Columns.Visible then
begin
datas[hang-1,lie]:=PDBset.Fields.Value;
inc(lie);
end; //end for i:=0 to PDBset.FieldCount-1
PDBset.Next;
end;// while not PDBset.Eof
with EWorksheet do
Range[cells.Item[2,1],cells.Item[PDBset.RecordCount+1,lie]].Value2:=datas;
result:=true;
EApp.Visible[0]:=true;
finally
PDBset.EnableControls;
EWorksheet.Disconnect;
EWorkbook.Disconnect;
EApp.Disconnect;
EApp.Free;
EWorkbook.Free ;
EWorksheet.Free;
datas:=Unassigned;
end;
end;
但我想改成导入已做好的Excel模板,那位高手来试,分不再加
这个函数是收藏的,望大家完善
function DBGridExp_EXC(DBGD:TDBgrid):boolean;
var
i,hang,lie:integer;
datas:Variant;
PDBset:^TADODataSet;
st:string;
EApp: TExcelApplication;
EWorkbook: TExcelWorkbook;
EWorksheet: TExcelWorksheet;
// Acolor:OlEVariant;
begin
// Acolor:=OlEVariant('CornSilk');
result:=false;
st:='';
hang:=1;
lie:=1;
PDBset:=@DBGD.DataSource.DataSet;
if PDBset.RecordCount>65530 then
if messageDlg('数据行数可能超过EXCEL最大限制,是否改用文本导出,忽略限制按NO',
mtWarning ,[mbYes,mbNo], 0)=mrYes then exit;
EApp := TExcelApplication.Create(application) ;
EWorkbook:=TExcelWorkbook.Create(application);
EWorksheet:=TExcelWorksheet.Create(application);
try
//--------连接Excel文件----------
EApp.Connect;
EWorkbook.ConnectTo(EApp.Workbooks.Add(emptyparam,0)); //好像这是里
EWorksheet.ConnectTo(EWorkbook.Worksheets[1] as _Worksheet);
for i:=0 to PDBset.FieldCount-1 do
if DBGD.Columns.Visible then
begin
st:=DBGD.Columns.Title.Caption;
{
with EWorksheet.Range[EWorksheet.Cells.Item[hang,lie],
EWorksheet.Cells.Item[hang,lie]] do
begin
Interior.Color:=DBGD.Columns.Title.Color;//clred;//Acolor;
// Font.Color:=DBGD.Columns.Title.Font.tColor;
// font.Size:=DBGD.Columns.Title.Font.Size;
// font.Name:= DBGD.Columns.Title.Font.Name;
//font.FontStyle:=DBGD.Columns.Title.Font.
end; }
EWorksheet.Cells.Item[hang,lie]:=st;
st:=PDBset.Fields.ClassName;
if (st='TDateField') or (st='TDateTimeField') then
with EWorksheet do
Range[cells.Item[2,lie],
cells.Item[PDBset.RecordCount+1,lie]].NumberFormatLocal:=
'[$-F800]dddd, mmmm dd, yyyy';
inc(lie);
end;
datas:=varArrayCreate([1,PDBset.RecordCount,1,lie],varVariant);
PDBset.First;
PDBset.DisableControls;
while not PDBset.Eof do
begin
inc(hang);
lie:=1;
for i:=0 to PDBset.FieldCount-1 do
if DBGD.Columns.Visible then
begin
datas[hang-1,lie]:=PDBset.Fields.Value;
inc(lie);
end; //end for i:=0 to PDBset.FieldCount-1
PDBset.Next;
end;// while not PDBset.Eof
with EWorksheet do
Range[cells.Item[2,1],cells.Item[PDBset.RecordCount+1,lie]].Value2:=datas;
result:=true;
EApp.Visible[0]:=true;
finally
PDBset.EnableControls;
EWorksheet.Disconnect;
EWorkbook.Disconnect;
EApp.Disconnect;
EApp.Free;
EWorkbook.Free ;
EWorksheet.Free;
datas:=Unassigned;
end;
end;