procedure TDM.CopyDbDataToExcel(Target: TDBGridEh;mb,FileName: string);
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;
//--------------------------选择模板－－－－－－
// CopyFile(pChar(Trim(ExtractFilePath(Application.ExeName)) mb '.xls'),pChar(FileName '1.xls'),false);
//－－－－－－－－－－－－－－－－－－－－－－－－
//通过ole创建Excel对象
try
XLApp := CreateOleObject('Excel.Application');
except
Screen.Cursor := crDefault;
Exit;
end;
if mb = '统计-项目信息前' then
XLApp.WorkBooks.Add[Trim(ExtractFilePath(Application.ExeName)) mb '.xls'] //你要把数据放在那里啊,先生成个文件在e:1.xls
else
XLApp.WorkBooks.Add;
XLApp.WorkBooks[1].WorkSheets[1].Name := 'sheet1';
Sheet := XLApp.Workbooks[1].WorkSheets['sheet1'];
if not Target.DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end;
Target.DataSource.DataSet.first;
for iCount := 0 to Target.Columns.Count - 1 do
begin
Sheet.cells[1, iCount 1] := trim(Target.Columns.Items[iCount].Title.Caption);
end;
jCount := 1;
while not Target.DataSource.DataSet.Eof do
begin
for iCount := 0 to Target.Columns.Count - 1 do //
begin
if iCount = 0 then
Sheet.cells[jCount 1, iCount 1] := IntToStr(jCount)
else
Sheet.cells[jCount 1, iCount 1] := trim(Target.Columns.Items[iCount].Field.AsString);
end;
Inc(jCount);
Target.DataSource.DataSet.Next;
end;
//--------------------可以在此添加Excel的宏－－－－－－－－－－－
软件开发网 www.mscto.com
XLApp.ActiveWorkbook.SaveAs(FileName:=FileName);
;
Screen.Cursor := crDefault;
XLApp.ActiveWorkbook.Close;
end;
-----------------------------------------StringGridToExcel
procedure TDM.CopySGDataToExcel(Target: TStringGrid;FileName: string);
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;
//通过ole创建Excel对象
try
XLApp := CreateOleObject('Excel.Application');
except
Screen.Cursor := crDefault;
Exit;
end;
XLApp.WorkBooks.Add; //你要把数据放在那里啊,先生成个文件在e:1.xls
XLApp.WorkBooks[1].WorkSheets[1].Name := 'sheet1';
Sheet := XLApp.Workbooks[1].WorkSheets['sheet1'];
Target.Row := 0;
for iCount := 0 to Target.RowCount - 1 do
begin
for jCount := 0 to Target.ColCount - 1 do
Sheet.cells[iCount 1, jCount 1] := Target.Cells[jCount,iCount];
Target.Row := iCount;
end;
XLApp.ActiveWorkbook.SaveAs(FileName:=FileName);
Screen.Cursor := crDefault;
XLApp.ActiveWorkbook.Close;
end; 软件开发网 www.mscto.com
