如何匯出TDBGrid資料至Excel

動機:
對於Delphi Form內顯示的TDBGrid資料,
常常使用者會要求能夠匯出至Excel格式,
俾提供做其他運用...

說明:
利用Delphi6支援的OLE Automation Object來呼叫Excel,
若使用者電腦未安裝Office而只有安裝免費的OpenOffice呢?!
別擔心...一樣可以匯出資料(待下回分解)!!

程式碼如下:

procedure TfmQueryP.btnExportClick(Sender: TObject);
var
  i, iTotal: Integer;
  xlsApp, xlsBook, xlsSheet: Variant;
begin

  if qyP.State = dsInActive then
  begin
    btnOkClick(Sender);
  end;

  if qyP.RecordCount < 1 then
  begin
    InfoMessage('此查詢條件下無資料可匯出!!');
    Exit;
  end;

  Tag := 0;

  //Do Export
  try
    xlsApp := GetActiveOleObject('Excel.Application');
  except
    try
      xlsApp := CreateOleObject('Excel.Application');
    except
      ErrorMessage('無法啟動Excel, 將啟動OpenOffice Calc');
      ExportToOpenOffice;
      Tag := 1;
      Exit;
    end;
  end;

  xlsBook := xlsApp.Workbooks.Add;

  xlsSheet := xlsBook.WorkSheets.Add;
  xlsSheet.Select;
  xlsSheet.Activate;

  xlsSheet.Cells[1, 1].Value := '第一個欄位名稱';
  xlsSheet.Cells[1, 2].Value := '第二個欄位名稱';
  xlsSheet.Cells[1, 3].Value := '第三個欄位名稱';
  xlsSheet.Cells[1, 4].Value := '第四個欄位名稱';
  xlsSheet.Cells[1, 5].Value := '第五個欄位名稱';
  xlsSheet.Cells[1, 6].Value := '第六個欄位名稱';

  qyP.DisableControls;

  i := 2;
  iTotal := qyP.RecordCount;

  qyP.First;

  while not qyP.EOF do
  begin
    xlsSheet.Cells[i, 1].Value := qyP.FieldByName('field1').AsString;
    xlsSheet.Cells[i, 2].Value := qyP.FieldByName('field2').AsString;
    xlsSheet.Cells[i, 3].Value := qyP.FieldByName('field3').AsInteger;
    xlsSheet.Cells[i, 4].Value := qyP.FieldByName('field4').AsString;
    xlsSheet.Cells[i, 5].Value := qyP.FieldByName('field5').AsString;
    xlsSheet.Cells[i, 6].Value := qyP.FieldByName('field6').AsInteger;

    Inc(i);

    StatusBar1.Panels.Items[0].Text := '匯出資料中：第 ' + IntToStr(i - 2) + ' 筆 / 共 ' + IntTostr(iTotal) + ' 筆';
    Application.ProcessMessages;
    qyP.Next;
  end;

  qyP.First;
  qyP.EnableControls;

  xlsSheet.Cells[1, 7].Value := '小計';    // =總人數
  xlsSheet.Range['A1:F1'].AutoFilter;

  if (i < 3) then
    xlsSheet.Cells[1, 8].Value := '=SUBTOTAL(9, F2:F2)'
  else
    xlsSheet.Cells[1, 8].Value := '=SUBTOTAL(9, F2:F' + IntToStr(i - 1) + ')';

  xlsApp.Visible := True;
  xlsApp := UnAssigned;
  Tag := 1;
  StatusBar1.Panels.Items[0].Text := '';
end;