高分求一段代码……

Question

我只有一段 数据库转成Excel的代码.其它的就参考一下了做.
下面是用控件来实现的.
//该控件将数据库转换到Excel
//用法是：把该组件的DataSet指向数据源.再用DbToExecl.DbToExec方法就可以了。
unit DbToExcel;
interface
uses
  SysUtils, Windows, Messages, Classes, Graphics,
  Controls, Forms, DBCtrls, StdCtrls, DBTables,
  ExtCtrls, Mask, Db, Dialogs, Excel97, Word97,
  OleServer {Excel2000,word2000};
type
  TDbToExcel = class(TComponent)
  DBToExcelapp:TExcelApplication;
  private
    FShowExcel:boolean;
    FDataset:TDataSet;
    { Private declarations }
  protected
    { Protected declarations }
  public
    Constructor Create(Owner:TComponent); override;
    Destructor  Destroy;override;
    procedure   DbToExcel;
    { Public declarations }
  published
    property ShowExcel:boolean read FShowExcel write FShowExcel  default True;
    property DataSet:TDataSet read FDataset write FDataset; 
    { Published declarations }
  end;procedure Register;implementation
uses ComObj, ActiveX;Constructor TDbToExcel.Create(Owner:TComponent);
begin
  inherited Create(owner);
  FShowExcel:=True;
end;Destructor  TDbToExcel.destroy;
begin
  inherited  Destroy;
end;
//如果为Excel97请参考Excel97.pas
//Excel2000没有实验
procedure TDbToExcel.DbToExcel;
var
//定义cell;
  RangeE: Excel97.Range;
  I, Row: Integer;
  Book: TBookStr;
begin
  //启动excel97并显示
//  CoInitialize (nil);
    DBToExcelapp:=TExcelApplication.Create(DBToExcelapp);
    DBToExcelapp.RemoteMachineName:='';
    DBToExcelapp.AutoConnect := False;
    try
    DBToExcelapp.ConnectKind := ckNewInstance;//ckRunningOrNew;
    except
    DBToExcelapp.ConnectKind :=ckRunningOrNew;
    end;
    DBToExcelapp.AutoQuit    := False;
//  DBToExcelapp.
    DBToExcelapp.Visible [0] := ShowExcel;
    application.ProcessMessages;
    DBToExcelapp.Workbooks.Add (NULL, 0);
   //填写表头
    RangeE := DBToExcelapp.ActiveCell;
    for I := 0 to DataSet.Fields.Count - 1 do
    begin
       RangeE.Value := DataSet.Fields [I].DisplayLabel;
       RangeE := RangeE.Next;
    end;
  //填数据到表中
    DataSet.DisableControls;
    try
       Book := DataSet.Book;
       try
         DataSet.First;
         Row := 2;
         while not DataSet.EOF do
          begin
             RangeE:=DBToExcelapp.Range ['A'+IntToStr(Row),'A'+IntToStr(Row)];
             for I := 0 to DataSet.Fields.Count - 1 do
                begin
                  RangeE.Value := DataSet.Fields [I].AsString;
                  RangeE := RangeE.Next;
                end; //end for
             DataSet.Next;
             Inc (Row);
             application.ProcessMessages;
          end;  //end while
       finally
         DataSet.Book := Book;
       end;
    finally
       DataSet.EnableControls;
    end;
          // 显示格式
  RangeE := DBToExcelapp.Range ['A1', 'E' + IntToStr (Row - 1)];
{    function  AutoFormat(Format: XlRangeAutoFormat; Number: OleVariant; Font: OleVariant;
                         Alignment: OleVariant; Border: OleVariant; Pattern: OleVariant;
                         Width: OleVariant): HResult; stdcall;}  RangeE.AutoFormat(1, NULL, NULL,1, NULL, NULL, NULL);
  DBToExcelapp.Free;  
 // DBToExcelapp.Quit;
end;procedure Register;
begin
  RegisterComponents('AFei', [TDbToExcel]);
end;initialization
//初始化COM服务
 CoInitialize (nil);end.在Delphi5/NT2000/Win98下通过.

Answer 1

使用Variant方式：var
  //变体变量
  VarWord:Variant;
  Range: Variant;
//打开Word工程,0为成功
function Open_MSWord:integer;
begin
  Result:=1;
  try
    //初始化内存空间
    if OleInitialize(nil)=S_OK then
    begin
      //打开Word
      VarWord:=CreateOleObject('Word.Application');
      //显示Word
      VarWord.visible:=True;
      //添加新Word文件
      VarWord.Documents.Add;
      //显示程序控制窗体
      Application.BringToFront;
      Result:=0;
    end
    else showmessage('Microsoft Word 环境初始化错误!');
  except
    showmessage('没有找到 Microsoft Word!');
  end;
end;
//若Word没有关闭则将其关闭
function Close_MSWord:integer;
begin
  Result:=1;
  try
    if not VarIsEmpty(VarWord) then
    begin
      VarWord.DisplayAlerts := False;  // Discard unsaved files....
      VarWord.Quit;                    // 退出WORD
      OleUninitialize();               // 清除内存空间
      Result:=0;
    end
    else Result:=0;
  except
    //ShowMessage(E.Message);
  end;
end;
//生成文件标题
procedure Set_WordFileTitle;
var
  i:integer;
begin
  //为第一个文档定义处理范围
  Range:=VarWord.Documents.Item(1).Range;
  //为文档设置字体属性——“标题 1”
  Range.Paragraphs.Item(1).Style:='标题 1';
  //为文档设置标题文字
  Range.Text := '人员名单';
  //文字居中对齐
  Range.Paragraphs.Item(1).Alignment:=1;
  //文字采用加粗
  Range.Paragraphs.Item(1).Style.Font.Bold:=True;
  //文字采用黑体
  Range.Paragraphs.Item(1).Style.Font.Name:='黑体';
  //添加段落
  for i := 1 to 2 do VarWord.Documents.Item(1).Paragraphs.Add;  //显示应用程序窗口
  Application.BringToFront;
end;
//保存当前WORD文档
procedure TForm_SaveToWord.SpeedButton_SaveClick(Sender: TObject);
begin
  //显示保存当前WORD文档
  try VarWord.Documents.Item(1).Save; except end;
end;//处理数据
procedure TForm_SaveToWord.Timer_ProcessTimer(Sender: TObject);
var
  My_Str:string;
  i:integer;
begin
  with My_DB_Model do
  try
    while not Query_Query.Eof do
    begin
      //My_Str:=; 取需要的字段
      //定义为段落尾部
      Range:=VarWord.Documents.Item(1).Range(
             VarWord.Documents.Item(1).Paragraphs.Item(
             VarWord.Documents.Item(1).Paragraphs.Count
             ).Range.Start);
      Range.Style:='正文';
      Range.Style.Font.Name:='宋体';
      Range.Text:=My_Str;
      //添加段落
      for i := 1 to 2 do
      VarWord.Documents.Item(1).Paragraphs.Add;
      //下一记录
      Query_Query.Next;
    end;
  finally
    //
  end;
end;

Answer 2

可不可以导出的时候不导出一些字段？
blob字段可以导出吗？

Answer 3

bde :procedure DataToExcel(dataset:tdataset);
var
  XLApp: Variant;
    i,j: Integer;
  Sheet: Variant;
  Book:TBookStr;
begin
  if (dataset.state=dsInactive) or (dataset.isempty)  then exit;
  try
     dataset.DisableControls;
     Book:=dataset.Book;
     XLApp:= CreateOleObject('Excel.Application');
     XLApp.Visible := True;
     XLApp.Workbooks.Add(-4167);
     XLApp.Workbooks[1].WorkSheets[1].Name :='系统数据';
     Sheet := XLApp.Workbooks[1].WorkSheets['系统数据'];
     for I:=1 to dataset.FieldCount do Sheet.Cells[1, i]:=dataset.Fields[i-1].FullName;
     j:=2;
     dataset.First;
     while not dataset.eof do
        begin
          for i := 1 to dataset.fieldcount do
              Sheet.Cells[j, i] :=dataset.FieldByName (dataset.fields[i-1].FieldName ).AsString;
          j:=j+1;
          dataset.next;
        end;
  finally
     dataset.EnableControls;
     dataset.Book:=Book;
  end;
end;ado:procedure adoquerytoexcel(Aadoquery:TCustomADODataSet) ;
var
  XLApp: Variant;
  i:integer;
  Sheet: Variant;
begin
     XLApp:= CreateOleObject('Excel.Application');
     XLApp.Visible := True;
     XLApp.Workbooks.Add(-4167);
     XLApp.Workbooks[1].WorkSheets[1].Name :='系统数据';
     Sheet := XLApp.Workbooks[1].WorkSheets['系统数据'];    for i := 1 to Aadoquery.fieldcount do
     begin
        Sheet.Cells[1, i] :=Aadoquery.fields[i-1].FieldName;
      end;
    sheet.cells[2,1].copyfromrecordset(AAdoQuery.recordset);
end;建议用ado方法，速度快很多！！！

Answer 4

各位大虾，能不能不调用连接库，原因：如果客户端没有安装Word,Excel怎么办？
直接写流文件！

Answer 5

用BDE和ADO加快速度有限，为什么？    因为"Word.Application"或"Excel.Application"调度使用的是ProgID查询接口的GUID再通过CoCreateInstance创建对象的。还好这一点一般每例只用一次。    又由于Variant采用滞后联编，每次使用其函数时又是以函数名通过IDispach接口的GetIDsOfName查询函数入口地址以及Invoke函数间接调用，此处时间消耗很大，远超过BDE与ADO的时间差。    举个例子，  //为第一个文档定义处理范围
  Range:=VarWord.Documents.Item(1).Range;
  //为文档设置字体属性——“标题 1”
  Range.Paragraphs.Item(1).Style:='标题 1';
  //为文档设置标题文字
  Range.Text := '人员名单';
  //文字居中对齐
  Range.Paragraphs.Item(1).Alignment:=1;
  //文字采用加粗
  Range.Paragraphs.Item(1).Style.Font.Bold:=True;
  //文字采用黑体
  Range.Paragraphs.Item(1).Style.Font.Name:='黑体';与  //为第一个文档定义处理范围
  VarWord.Documents.Item(1).Range:=VarWord.Documents.Item(1).Range;
  //为文档设置字体属性——“标题 1”
  VarWord.Documents.Item(1).Range.Paragraphs.Item(1).Style:='标题 1';
  //为文档设置标题文字
  VarWord.Documents.Item(1).Range.Text := '人员名单';
  //文字居中对齐
  VarWord.Documents.Item(1).Range.Paragraphs.Item(1).Alignment:=1;
  //文字采用加粗
  VarWord.Documents.Item(1).Range.Paragraphs.Item(1).Style.Font.Bold:=True;
  //文字采用黑体
  VarWord.Documents.Item(1).Range.Paragraphs.Item(1).Style.Font.Name:='黑体';相比要快许多，我是实际实验过的。    所以，要想有效的提高速度，最好直接使用接口调用，譬如使用Delphi提供的Server页面的组件，但它的麻烦之处是——需要为每个函数很精确地填充数个参数，即便使用空的OleVariant仍然很费劲。

Answer 6

To yonhon_jj()：    虽然M$提供了一系列OLE文档的结构化存储函数、属性页函数等，但是它没有提供自己的DOC、XLS文件的流格式。即便你知道，你还需要在自己的程序里非大力气来构造这些格式。    问一句，你真愿意这么干么？

Answer 7

to enlightenment
这一段代码中并没有看到把数据库的数据写到word中的语句啊？//处理数据
procedure TForm_SaveToWord.Timer_ProcessTimer(Sender: TObject);
var
  My_Str:string;
  i:integer;
begin
  with My_DB_Model do
  try
    while not Query_Query.Eof do
    begin
      //My_Str:=; 取需要的字段
      //定义为段落尾部
      Range:=VarWord.Documents.Item(1).Range(
            VarWord.Documents.Item(1).Paragraphs.Item(
            VarWord.Documents.Item(1).Paragraphs.Count
            ).Range.Start);
      Range.Style:='正文';
      Range.Style.Font.Name:='宋体';
      Range.Text:=My_Str;
      //添加段落
      for i := 1 to 2 do
      VarWord.Documents.Item(1).Paragraphs.Add;
      //下一记录
      Query_Query.Next;
    end;
  finally
    //
  end;
end;

Answer 8

上面的：  //My_Str:=; //取需要的字段就是让你在此处执行相应的读数据库写文本的代码。