如何用delphi将结果集中的内容导出成excel格式?

Question

如何用delphi将结果集中的内容导出成excel格式?能给我一段代码吗?

Answer 1

function SaveAsExcelFile(AGrid: TStringGrid; ASheetName, AFileName: string): Boolean;
const
  xlWBATWorksheet = -4167;
var
  XLApp, Sheet, Data: OLEVariant;
  i, j: Integer;
begin
  // Prepare Data
  Data := VarArrayCreate([1, AGrid.RowCount, 1, AGrid.ColCount], varVariant);
  for i := 0 to AGrid.ColCount - 1 do
    for j := 0 to AGrid.RowCount - 1 do
      Data[j + 1, i + 1] := AGrid.Cells[i, j];  // Create Excel-OLE Object
  Result := False;
  XLApp := CreateOleObject('Excel.Application');
  try
    XLApp.Visible := true;    // Add new Workbook
    XLApp.Workbooks.Add(xlWBatWorkSheet);
    Sheet := XLApp.Workbooks[1].WorkSheets[1];
    Sheet.Name := ASheetName;
    // Fill up the sheet
    Sheet.Range[RefToCell(1, 1), RefToCell(AGrid.RowCount,AGrid.ColCount)].Value := Data;   // Save Excel Worksheet
    try
      XLApp.Workbooks[1].SaveAs(AFileName);
      Result := True;
    except
      // Error
    end;
  finally
    // Quit Excel
    if not VarIsEmpty(XLApp) then
    begin
      XLApp.DisplayAlerts := False;
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
    end;
  end;
end;procedure TForm1.Button2Click(Sender: TObject);
begin
  if SaveAsExcelFile(stringGrid1, 'My Stringgrid Data', ExtractFilePath (Application.ExeName)+'MyExcelFile.xls') then
    ShowMessage('StringGrid saved!');
end;

Answer 2

説明：上述是把TStringGrid中的数据移到Excel

Answer 3

procedure TForm1.Button2Click(Sender: TObject);
var
  MyExc,MyWorkBook : Variant;
  iCount,jCount : Integer;
begin
  SaveDialog1.FileName:=ExtractFilePath(ParamStr(0))+'book1.xls';
  if SaveDialog1.Execute then
  begin
    Screen.Cursor := crHourGlass;
    if Not VarIsEmpty(MyExc) then
    begin
      MyExc.DisplayAlters := False;
      MyExc.Quit;
      VarClear(MyExc);
    end;
    try
      MyExc := CreateOleObject('Excel.Application');
      MyWorkBook := CreateOleObject('Excel.Sheet');
    except
      Screen.Cursor := crDefault;
      Application.MessageBox('您没有安排Excel或应用程序正在被使用,Excel创建失败！','哈哈',MB_OK + MB_ICONINFORMATION);
      Exit;
    end;
    MyExc.WorkBooks.Add;
    MyExc.WorkSheets[1].Activate;
    MyExc.WorkBooks[1].WorkSheets[1].Name := DBGrid1.Name;
    MyWorkBook := MyExc.WorkBooks[1].WorkSheets[(DBGrid1).Name];
    if not DBGrid1.DataSource.DataSet.Active then
    begin
      MyExc.WorkBooks.Close;
      MyExc.Quit;
      VarClear(MyExc);
      Screen.Cursor := crDefault;
      Exit;
    end;
    try
      for iCount := 0 to DBGrid1.Columns.Count - 1 do
        MyWorkBook.Cells[1,iCount + 1] := DBGrid1.Columns.Items[iCount].Title.Caption;
      jCount := 1;
      DBGrid1.DataSource.DataSet.First;
      while not DBGrid1.DataSource.DataSet.Eof do
      begin
        for iCount := 0 to DBGrid1.Columns.Count - 1 do
          MyWorkBook.Cells[jCount + 1,iCount + 1] := DBGrid1.Columns.Items[iCount].Field.AsString;
        Inc(jCount);
        DBGrid1.DataSource.DataSet.Next;
      end;
       MyWorkBook.SaveAs(SaveDialog1.FileName);
       Application.MessageBox('成功生成Excel!','呵呵',MB_OK+ MB_ICONINFORMATION);
    finally
      MyExc.WorkBooks.Close;
      MyExc.Quit;
      VarClear(MyExc);
      Screen.Cursor := crDefault;
    end;
  end;
end;

Answer 4

tensionli()给我的也是从TStringGrid中的数据移到Excel中吗?另外请问:我还用在form上加别的什么组件吗?怎么设置?多谢!

Answer 5

Sorry! 我上面给的, 少了一个函数。function RefToCell(ARow, ACol: Integer): string;
begin
  Result := Chr(Ord('A') + ACol - 1) + IntToStr(ARow);
end;