导出Excel

procedure ExportDBGridToExcel(Grid: TDBGrid; DisableScreenUpdating: Boolean;
  ReportCaption,ReportMemo,ReportTtl :string);
const
  CLASS_ExcelApplication: TGUID 
= '{00024500-0000-0000-C000-000000000046}';

var
  ExcelApp: OleVariant;
  Unknown: IUnknown;
  Bm: TBookmarkStr;
  Col, Row: Integer;
  I: Integer;
begin
  
if (Grid.DataSource <> niland (Grid.DataSource.DataSet <> nilthen
    
with Grid.DataSource.DataSet do
    
begin
      try
        
if not Succeeded(GetActiveObject(CLASS_ExcelApplication, nil, Unknown)) then
          Unknown :
= CreateComObject(CLASS_ExcelApplication);
      except
        raise Exception.Create(
'不能启动 Microsoft Excel,请确认 Microsoft Excel 已正确安装在本机上');
      
end;
      ExcelApp :
= Unknown as IDispatch;
      ExcelApp.Visible :
= True;
      ExcelApp.Workbooks.Add;
      
if DisableScreenUpdating then
        ExcelApp.ScreenUpdating :
= False;
      DisableControls;
      try
        Bm :
= Bookmark;
        First;
        ExcelApp.Cells[
11] := ReportCaption;
        ExcelApp.Cells[
21] := ReportMemo;
        ExcelApp.Cells[
31] := ReportTtl;
        Row :
= 4;
        Col :
= 1;
        
for I := 0 to Grid.Columns.Count - 1 do
        
begin
          
if Grid.Columns[I].Visible then
            ExcelApp.Cells[Row, Col] :
= Grid.Columns[I].Title.Caption;
          Inc(Col);
        
end;
        Inc(Row);
        
while not EOF do
        
begin
          Col :
= 1;
          
for I := 0 to Grid.Columns.Count - 1 do
          
begin
            
if Grid.Columns[I].Visible then
              ExcelApp.Cells[Row, Col] :
= Grid.Columns[I].Field.DisplayText;
            Inc(Col);
          
end;
          Inc(Row);
          Next;
        
end;
        Col :
= 1;
        
for I := 0 to Grid.Columns.Count - 1 do
        
begin
          
if Grid.Columns[I].Visible then
            ExcelApp.Columns[Col].AutoFit; ;
          Inc(Col);
        
end;
        Bookmark :
= Bm;
      finally
        EnableControls;
        
if not ExcelApp.ScreenUpdating then
          ExcelApp.ScreenUpdating :
= True;
      
end;
      ExcelApp.ActiveWorkbook.PrintPreview;
    
end;
end;
posted @ 2008-08-05 12:34  威尼斯的夏天  阅读(180)  评论(0编辑  收藏  举报