用Delphi将数据导入到已经存在的Excel中

Question

各位高手帮帮忙！给出我一个可以实现的语句！

Answer 1

procedure TForm1.Button2Click(Sender: TObject);
var
  ex: OleVariant;
  i, j: Integer;
  fi: TINIFile;
  st: string;
begin
  fi := TINIFile.Create(ChangeFileExt(Application.ExeName, '.INI'));
  fi.WriteString('IBToExcel', 'ExcelFileName', ExcelFileName.Text);
  fi.WriteString('IBToExcel', 'IBDataBase', IBDataBase.Text);
  st := '';
  for i:=0 to Memo1.Lines.Count do
    st := st + Memo1.Lines[i] + ' ';
  fi.WriteString('IBToExcel', 'SQL', st);
  fi.Free;
  Memo2.Lines.Add('打开数据库...');
  if IBTransaction1.InTransaction then
    IBTransaction1.Rollback;
  IBDataBase1.Close;
  IBDataBase1.DatabaseName := IBDataBase.Text;
  IBDataBase1.Open;
  IBTransaction1.StartTransaction;
  Memo2.Lines.Add('执行SQL查询...');
  IBSQL1.SQL.Clear;
  IBSQL1.SQL.Text := Memo1.Text;
  IBSQL1.ExecQuery;
  if IBSQL1.Eof then
    begin
      Memo2.Lines.Add('没有数据。');
      Exit;
    end;
  Memo2.Lines.Add('打开Excel文件...');
  ex := CreateOleObject('Excel.Application');
  if FileExists(ExcelFileName.Text) then
    ex.WorkBooks.Open(ExcelFileName.Text)
  else
    ex.WorkBooks.Add;
  Memo2.Lines.Add('设置列名...');
  for j:=0 to IBSQL1.FieldCount - 1 do
    ex.Cells[1, j+1] := IBSQL1.Fields[j].Name;
  Memo2.Lines.Add('...');
  i := 2;
  while not IBSQL1.Eof do
    begin
      for j:=0 to IBSQL1.FieldCount - 1 do
        ex.Cells[i, j+1] := IBSQL1.Fields[j].AsString;
      IBSQL1.Next;
      Inc(i);
      Memo2.Lines[Memo2.Lines.Count - 1] := '已输出' + IntToStr(i-1) + '个记录...';
      Application.ProcessMessages;
    end;
  if FileExists(ExcelFileName.Text) then
    ex.ActiveWorkBook.Close(1)
  else
    begin
      ex.ActiveWorkBook.SaveAs(ExcelFileName.Text);
      ex.ActiveWorkBook.Close(0);
    end;
  ex := Unassigned;
  IBTransaction1.Commit;
  IBDataBase1.Close;
  Memo2.Lines.Add('成功。');
end;

Answer 2

unit dbtoexcel;interface
uses oleserver, ConvUtils, ComObj,Dialogs,adodb,Classes,SysUtils,forms;
type
  Tdbtoexcel =class
  private
  public
  function SaveDbToExcel(dataset : TADODataSet) : Byte;
end;implementation{ Tdbtoexce }
function Tdbtoexcel.SaveDbToExcel(dataset : TADODataSet): Byte;
var
  ExcelApp,WorkBook : OleVariant;
  FieldName : string;
  FieldCount,i,j,RecordCount : Integer;
begin
  try
    try
      ExcelApp := CreateOleObject('Excel.Application');
      WorkBook:=CreateOleObject('Excel.Sheet');
    except
      ShowMessage('没有安装EXCEL');
      Result := 0; //失败返回0
      exit;
    end;
    try
      ExcelApp.Caption := '应用程序调用 Microsoft Excel';
      WorkBook:=ExcelApp.workbooks.Add;
      dataset.Open;
      FieldCount := dataset.FieldCount;
      RecordCount := dataset.RecordCount;
      for i:=1 to FieldCount do //根据DATASET的字段名称写EXCEL的第一行.
      begin
        ExcelApp.Cells[1,i] :=dataset.Fields[i-1].FieldName;
      end;
      for i:=2 to RecordCount do //从第二行开始，把DATASET中的所有记录都写入EXCEL文件.
      begin
        for j:=1 to FieldCount do
        ExcelApp.Cells[i,j] :=dataset.FieldByName(dataset.Fields[j-1].FieldName).AsString;
        dataset.Next;
      end;
      WorkBook.SaveAs(ExtractFileDir(Application.ExeName)+'\test.xls');
      ShowMessage('文件已经保存为'+ExtractFileDir(Application.ExeName)+'\test.xls。您可以打开编辑此文件');
      Result := 1;//成功返回1
    except
      Result := 0; //失败返回0
    end;
  finally
    ExcelApp.WorkBooks.Close;
    ExcelApp.quit;
  end;
end;end.

Answer 3

ex := CreateOleObject('Excel.Application');
  if FileExists('职务.xls') then
    ex.WorkBooks.Open('职务.xls')
  else
    ex.WorkBooks.Add;
...
  ex.Cells[1, 1] := '我爱你';  // 把A1这个单元格的内容设为'我爱你'
...
  if FileExists('职务.xls') then
    ex.ActiveWorkBook.Close(1)
  else
    begin
      ex.ActiveWorkBook.SaveAs('职务.xls');
      ex.ActiveWorkBook.Close(0);
    end;