100分请高手改个数据导入Excel的函数 ( 积分: 100 )

  • 主题发起人 主题发起人 yangxiufengcom
  • 开始时间 开始时间
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;
 
自己顶一下
 
给你个word用模版保存dateset数据的例子,希望能给你点启发。
var
savefilename:string;
templateFile:string;
filename:string;
title1,title2:string;
count,tabcount,k:integer;
vTable: Variant;
row1:Row;
begin
count:=0;
picfieldname:=UpperCase(trim(EdPicField.Text));
ProgressBar1.Min:=0;
ProgressBar1.Max:=ADOQuery1.RecordCount;
ProgressBar1.Position:=0;
IF SaveDialog1.Execute THEN
savefilename:=SaveDialog1.FileName
else
exit;
templateFile:=EdtemplateFile.Text;
if not FileExists(templateFile) then
begin
showmessage('请选择模板文件!!!');
exit;
end;
createwordfile(templateFile);
WordApp.ActiveDocument.Tables.Item(1).Select;
WordApp.Selection.Copy;
adoquery1.First;
while not ADOQuery1.eof do
begin
if title1<>adoquery1.Fields[0].AsString then
begin
title1:=adoquery1.Fields[0].AsString;
// WordApp.ActiveDocument.Range.InsertParagraphAfter;
WordApp.Selection.TypeParagraph;
WordApp.Selection.EndKey(Unit:=wdStory);
count:=count+1;
wordapp.Selection.TypeText(Text:='('+inttostr(count)+')'+title1+'(静态数据)设备管理');
WordApp.Selection.TypeParagraph;
WordApp.Selection.Paste;
tabcount:=WordApp.ActiveDocument.tables.count;
vTable := wordApp.ActiveDocument.Tables.Item(tabcount);
vtable.select;
k:=2;
end;
if k>2 then
WordApp.Selection.InsertRowsBelow(1);
vTable.Cell(k, 1).Range.Text:=adoquery1.fields[1].AsString;
vTable.Cell(k, 2).Range.Text:=adoquery1.fields[2].asstring;
vTable.Cell(k, 3).Range.Text:=adoquery1.fields[3].asstring;
vTable.Cell(k, 4).Range.Text:=adoquery1.fields[4].asstring;
vTable.Cell(k, 5).Range.Text:=adoquery1.fields[5].asstring;
vTable.Cell(k, 6).Range.Text:=adoquery1.fields[6].asstring;
vTable.Cell(k, 7).Range.Text:=adoquery1.fields[7].asstring;
vTable.Cell(k, 8).Range.Text:=adoquery1.fields[8].asstring;
k:=k+1;
ADOQuery1.next;
if title1<>ADOQuery1.fields[0].asstring then
begin
WordApp.Selection.EndKey(Unit:=wdStory);
//WordApp.Selection.TypeParagraph;
wordapp.Selection.InsertCaption(Label:='3.2.', TitleAutoText:='InsertCaption1',Title:=title1, Position:=wdCaptionPositionBelow);
wordapp.Selection.TypeText(Text:=title1);
wordapp.Selection.ParagraphFormat.Alignment:=wdAlignParagraphCenter;
// wordapp.Selection.ParagraphFormat.Alignment:=wdAlignParagraphJustify;
end;

end;
saveAS(savefilename);
WordApp.Quit;
showmessage('保存完成!');
end;
 
高手能不能破一下, EXCEL服务器,欣赏他是网络版的
 
你到底要做什么啊?有点没理解你的意思
 
后退
顶部