如何将DELPHI6编的数据库报表在WORD和EXCEL中打印

Question

给你一个写入Excel的列子，或许对你有帮助
 用OLE的方法 
uses comobj;
procedure TstartForm.SpeedButton10Click(Sender: TObject);
var MSExcel:Variant;
begin
MSExcel:=CreateOLEObject('Excel.Application');
MSExcel.WorkBooks.Add;
MSExcel.Visible:=True;for i:=5 to Query1.RecordCount+4 do
begin
MsExcel.Cells[i,1].value:=Query1.FieldByName('cpxhno').Asstring;
MsExcel.Cells[i,2].value:=Query1.FieldByName('cpname').Asstring;
MsExcel.Cells[i,3].value:=Query1.FieldByName('cpunit').Asstring;
MsExcel.Cells[i,4].value:=Query1.FieldByName('htnumber').Asstring;
MsExcel.Cells[i,5].value:=Query1.FieldByName('number').Asstring;
MsExcel.Cells[i,6].value:=Query1.FieldByName('ljno').Asstring;
end;
end;退出Excel:
MSExcel.Quit;
MSExcel:=Unassigned; //释放VARIANT变
***************
先加入ExcelApplication1;ExcelWorkbook1;ExcelWorksheet1;
procedure TForm1.n1Click(Sender: TObject);
var
row,brea:integer;
a,b,c,d,e:shortstring;
begin
if table1.active = True then begin
try
ExcelApplication1.Connect;
Except
ExcelApplication1.free;
Abort;
end;
brea := strtoint(inputbox('输入需导入行数！','行数','10'));
if brea<1 then brea := 10;
ProgressBar1.Visible := True;
ProgressBar1.Max := brea;
ExcelApplication1.Visible[0] := true;
for row := 2 to brea do
begin
a := ExcelWorksheet1.Cells.Item[row,2];
b := ExcelWorksheet1.Cells.Item[row,1];
c := ExcelWorksheet1.Cells.Item[row,3];
d := ExcelWorksheet1.Cells.Item[row,4];
e := ExcelWorksheet1.Cells.Item[row,5];
form1.show;
table1.AppendRecord([a,b,c,d,e]);
ProgressBar1.Position := row-1;
end;
ProgressBar1.Hide;
end;
end;
*****************
var
MSExcel: Variant;
i: Integer;
begin
OpenDialog1.Filter:='*.XLS|*.XLS';
OpenDialog1.DefaultExt:='XLS';
if OpenDialog1.Execute then
begin
MSExcel:=CreateOLEObject('Excel.Application');
MSExcel.WorkBooks.Open(OpenDialog1.FileName);
MSExcel.Visible:=False;
//从有数据的行逐行读入数据
for i:=1 to MSExcel.ActiveSheet.UsedRange.Rows.Count do
begin
Edit2.Text:=Edit2.Text+MSExcel.Cells[i,1].Value;
end;
MSExcel.ActiveWorkBook.Close;
MSExcel.Quit;
end;
end;

Answer 1

有一个控件叫VExport什么的，可以转出到word和excell，我试过，效果非常好。

Answer 2

倒入把
用vigrous_chen(风) 的

Answer 3

参考一下：unit Uprint;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtnrs, StdCtrls, Buttons, Grids, DBGrids, ExtCtrls,comobj, DBCtrls,db,
  QuickRpt, Qrctrls, ComCtrls, ToolWin, QRPrntr,Excel97,Word97;type
  TForm4 = class(TForm)
    DBGrid1: TDBGrid;
    STBar: TStatusBar;
    Panel2: TPanel;
    BinExcel: TBitBtn;
    BinWord: TBitBtn;
    BinExt: TBitBtn;
    procedure BinWordClick(Sender: TObject);
    procedure BinExcelClick(Sender: TObject);
    procedure BinExtClick(Sender: TObject);
    procedure DBGrid1TitleClick(Column: TColumn);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    XlsApp : OleVariant;
    XlsSheet: OleVariant;
    { Public declarations }
  end;var
  Form4: TForm4;implementationuses main, Udm,UPub;
const
  xlWBATWorksheet = -4167;
{$R *.DFM}
procedure TForm4.FormShow(Sender: TObject);
begin
  DBGrid1.Visible := true;
  dgredraw(Form1.sjk,'',DBGrid1);
end;procedure TForm4.BinExcelClick(Sender: TObject);
var
  I,J : Integer;
  TmpFileName : String;
  SelField,SelRec : Integer;
  PrintAll : Boolean;
begin
  STBar.Panels[0].Text := '';
  PrintAll := false;
  if DBGrid1.SelectedRows.Count = 0 then
  begin
    if MessageDlg('当前没有选定打印的记录,是否全部打印?',mtconfirmation,[Mbyes,Mbno],0) = mrno then
    begin
      Application.MessageBox(pchar('没有选定的数据记录,打印终止!'),pchar('注意'),mb_ok);
      Abort;
    end else
      PrintAll := true;
  end;  try
    STBar.Panels[0].Text := '正在启动Excel...';
    if VarIsEmpty(XlsApp) then
      XlsApp := Createoleobject('Excel.Application');
//    XlsApp.ActiveSheet.Name := 'DataTransTmp';
    XLsApp.Workbooks.Add;
    XlsSheet := XLsApp.Worksheets['Sheet1'];
//    XlsSheet.Activesheets.Name := 'DataTransTmp';
  except
    Application.MessageBox(pchar('Ms Excel 无法启动,数据转入终止!'),pchar('注意'),mb_ok);
    BinExcel.Enabled := false;
    STBar.Panels[0].Text := 'Excel无法启动';
    Abort;
  end;  STBar.Panels[0].Text := '数据正在转移至Excel';  SelField := 0;
  for  J := 0 to Dbgrid1.Columns.Count-1 do
  begin
    if (dbgrid1.Columns[j].Visible<>false) and (dbgrid1.Columns[j].color<>clgray) then
    begin
      SelField := SelField + 1;
      XlsSheet.Cells[3, SelField] := dbgrid1.Columns[j].Title.Caption;
    end;
  end;  SelRec := 0;
  with dm1.QryMain do
  begin
    first;
    for  I := 0 to RecordCount-1 do
    begin
      if not PrintAll then
      begin
        if not DBGrid1.SelectedRows.CurrentRowSelected then
        begin
          Next;
          Continue
        end;
      end;      SelRec := SelRec + 1;
      SelField := 0;
      for J := 0 to Dbgrid1.Columns.Count-1 do
      begin
        if (dbgrid1.Columns[j].Visible<>false) and (dbgrid1.Columns[j].color<>clAqua) then
        begin
          SelField  := SelField + 1;
          if StrToIntDef(Fields[J].AsString, -1) <> -1 then
            XlsSheet.Cells[selRec + 3, SelField] := '''' + Fields[J].Asstring
          else
            XlsSheet.Cells(selRec + 3, SelField) := Fields[J].Asstring
        end;
      end;
      Next;
    end;
  end;
  XlsApp.Visible := true;
  STBar.Panels[0].Text := '数据转移成功,请使用Excel打印所选定的数据';
{  Application.MessageBox(pchar('数据已转入至Excel文件中,请于下列路径中查看:' + #13#10
                               + '  ' + TmpFileName),pchar('注意'),mb_ok);}
end;procedure TForm4.BinWordClick(Sender: TObject);
var
  WordApp,WordDoc,WordParagraph,WordRange,WordTable:variant;
  SltRec,SltCol,VisCol :integer;
  ColIndex,RowIndex : Integer;
  I,J : integer;
  PrintAll : Boolean;
begin
  STBar.Panels[0].Text := '';
  PrintAll := false;
  if DBGrid1.SelectedRows.Count = 0 then
  begin
    if MessageDlg('当前没有选定打印的记录,是否全部打印?',mtconfirmation,[Mbyes,Mbno],0) = mrno then
    begin
      Application.MessageBox(pchar('没有选定的数据记录,打印终止!'),pchar('注意'),mb_ok);
      Abort;
    end else
      PrintAll := true;
  end;  try
    if VarIsEmpty(WordApp) then
      WordApp := CreateOleObject('word.Application');    WordDoc := WordApp.documents.add;
    WordParagraph := WordApp.activedocument.paragraphs.add;    WordRange := WordParagraph.range;
    //  WordRange.text:= dm1.QryMain.TableName +#13+'  ';
    WordRange.Font.Size := 18;
    WordRange.Font.Name := '宋体';
    //  WordRange.Font.style := fsbold;
  except
    Application.MessageBox(pchar('Ms Word 无法启动,数据转入终止!'),pchar('注意'),mb_ok);
    BinWord.Enabled := false;
    STBar.Panels[0].Text := 'Ms Word 无法启动';
    Abort;
  end;
  STBar.Panels[0].Text := '数据正在转移至Word';  //统计打印行数
  if PrintAll then
    SltRec := dm1.QryMain.RecordCount
  else
    SltRec:=DBGrid1.SelectedRows.Count;  //统计打印列数
  SltCol := 0;
  VisCol := 0;
  for j := 0 to DBGrid1.Columns.Count-1 do
  begin
    if DBGrid1.Columns[J].Visible then
    begin
      VisCol := VisCol + 1;      if DBGrid1.Columns[j].Title.Color=clAqua then
      begin
        SltCol := SltCol + 1;
      end;
    end;
  end;
  if SltCol = 0 then
    SltCol := VisCol;  WordRange := WordApp.ActiveDocument.Content;
  WordRange.Collapse(wdCollapseEnd);
  WordTable:= WordApp.activedocument.tables.add(WordRange,SltRec + 1,SltCol);  {打印表头}
  ColIndex := 1;
  for  j := 0 to dbgrid1.Columns.Count-1  do
  begin
    if SltCol <> VisCol then
    begin
      if (dbgrid1.Columns[j].Visible = false) or (dbgrid1.Columns[j].Title.color <> clAqua) then
        Continue;
    end;    WordTable.Cell(1,ColIndex).Range.InsertAfter(dbgrid1.Columns[j].Title.Caption);
    DBGrid1.Columns[J].Title.Color := clAqua;
    ColIndex := ColIndex + 1;
  end;  //打印数据
  dm1.QryMain.First;
  RowIndex := 2;
  ColIndex := 1;
  while not dm1.QryMain.Eof do
  begin
    if SltRec <> dm1.QryMain.RecordCount then
    begin
      if dbgrid1.SelectedRows.CurrentRowSelected = false then
      begin
        dm1.QryMain.Next;
        Continue;
      end;
    end;    for j := 0 to dbgrid1.Columns.Count-1 do begin
      if (dbgrid1.Columns[j].Visible<>false) and (dbgrid1.Columns[j].Title.color=clAqua) then
      begin
        WordTable.Cell(RowIndex,ColIndex).Range.InsertAfter
          (dm1.QryMain.Fieldbyname(dbgrid1.Columns[j].FieldName).asstring);
        ColIndex := ColIndex + 1;
      end;
    end;
    RowIndex := RowIndex + 1;
    ColIndex := 1;
    dm1.QryMain.Next;
  end;{End of While...not...}
  WordApp.Visible := true;
  STBar.Panels[0].Text := '数据转移成功,请使用Word打印所选定的数据';
  for j := 0 to dbgrid1.Columns.Count-1 do
    DBGrid1.Columns[J].Title.Color := clAqua;
end;procedure TForm4.BinExtClick(Sender: TObject);
begin
{  TmpFileName := 'C:\My Documents\' + Form1.sjk + IntToStr(random(1000)) + '.xls';
  XlsSheet.SaveAs(TmpFileName);
  XlsSheet.Application.Quit;}{  if not VarIsEmpty(XlsApp) then
  begin
    XlsApp.DisplayAlerts := True;  // 7Discard unsaved files....
    try
      XlsApp.Application.Quit;
    except
    end;
  end;}  close;
end;procedure TForm4.DBGrid1TitleClick(Column: TColumn);
begin
  if column.Color=clAqua then
    Column.Color:=clwindow
  else
    if column.Color=clAqua then
    column.Color:=clgray;
end;
end.

Answer 4

好长啊！ cobi(我是小新) 方法好些