虚心请教,我是入门着

Question

怎样把数据库的查询结果保存到电子表格文件中

Answer 1

uses   
      Windows,Graphics,DB,Grids,   DBGrids,StdCtrls,forms,Sysutils,classes,   
      Controls,comobj,comctrls,Dialogs,Variants;   
    
    
  function   ExportToExcel(dbgrid:tdbgrid):boolean;   
  const   
      xlNormal=-4143;   
  var   
      i,j,k:integer;   
      str,filename:string;   
      excel:OleVariant;   
      SavePlace:   TBook;   
      savedialog:tsavedialog;   
      ProgressBar1:TProgressBar;   
  begin   
      result:=false;   
      filename:='';   
      if   not   dbgrid.DataSource.DataSet.Active   then   
            begin   
                application.MessageBox('数据集尚未打开！','错误',0);   
                exit;     
            end;   
      screen.Cursor:=crHourGlass;   
      try   
          excel:=CreateOleObject('Excel.Application');   
          excel.workbooks.add;   
      except   
            screen.cursor:=crDefault;   
          showmessage('无法调用Excel！');   
          exit;   
      end;   
      savedialog:=tsavedialog.Create(nil);   
      savedialog.Filter:='Excel文件(*.xls)|*.xls';   
      if   savedialog.Execute   then   
            begin   
                if   FileExists(savedialog.FileName)   then   
                      try   
                          if   application.messagebox('该文件已经存在，要覆盖吗？','询问',mb_yesno+mb_iconquestion)=idyes   then   
                                DeleteFile(PChar(savedialog.FileName))   
                          else   
                                begin   
                                    Excel.Quit;   
                                    savedialog.free;   
                                      screen.cursor:=crDefault;   
                                    Exit;   
                                end;   
                      except   
                          Excel.Quit;   
                          savedialog.free;   
                            screen.cursor:=crDefault;   
                          Exit;   
                      end;   
                filename:=savedialog.FileName;   
            end;   
      savedialog.free;   
      if   filename=''   then   
            begin   
                result:=true;   
                Excel.Quit;   
                screen.cursor:=crDefault;   
                exit;   
            end;   
      k:=0;   
      for   i:=0   to   dbgrid.Columns.count-1   do   
          begin   
              if   dbgrid.Columns.Items[i].Visible   then   
                    begin   
                        //Excel.Columns[k+1].ColumnWidth:=dbgrid.Columns.Items[i].Title.Column.Width;   
                        excel.cells[1,k+1]:=dbgrid.Columns.Items[i].Title.Caption;   
                        inc(k);   
                    end;   
          end;   
    
      dbgrid.DataSource.DataSet.DisableControls;   
      saveplace:=dbgrid.DataSource.DataSet.GetBook;   
      dbgrid.DataSource.dataset.First;   
      i:=2;   
    
      ProgressBar1:=ProgressBarform(dbgrid.DataSource.DataSet.RecordCount);   
      while   not   dbgrid.DataSource.dataset.Eof   do   
          begin   
              k:=0;   
              for   j:=0   to   dbgrid.Columns.count-1   do   
                  begin   
                      if   dbgrid.Columns.Items[j].Visible   then   
                            begin   
                                excel.cells[i,k+1].NumberFormat:='@';   
                                if   not   dbgrid.DataSource.dataset.fieldbyname(dbgrid.Columns.Items[j].FieldName).isnull   then   
                                      begin   
                                          str:=dbgrid.DataSource.dataset.fieldbyname(dbgrid.Columns.Items[j].FieldName).value;   
                                          Excel.Cells[i,   k   +   1]   :=   Str;   
                                      end;   
                                inc(k);   
                            end   
                      else   
                            continue;   
                  end;   
              inc(i);   
              ProgressBar1.StepBy(1);   
              dbgrid.DataSource.dataset.next;   
          end;   
      progressbar1.Parent.Free;   
    
      dbgrid.DataSource.dataset.GotoBook(SavePlace);   
      dbgrid.DataSource.dataset.EnableControls;   
    
      try   
          if   copy(FileName,length(FileName)-3,4)<>'.xls'   then   
                FileName:=FileName+'.xls';   
          Excel.ActiveWorkbook.SaveAs(FileName,   xlNormal,   '',   '',   False,   False);   
      except   
          Excel.Quit;   
            screen.cursor:=crDefault;   
          exit;   
      end;   
      Excel.Visible   :=   true;   
      screen.cursor:=crDefault;   
      Result   :=   true;   
  end;   
    
  function   ProgressBarform(max:integer):tProgressBar;   
  var   
      ProgressBar1:tProgressBar;   
      form:tform;   
  begin   
      application.CreateForm(tform,form);   
      form.Position:=poScreenCenter;   
      form.BorderStyle:=bsnone;   
      form.Height:=30;   
      form.Width:=260;   
      ProgressBar1:=tProgressBar.Create(form);   
      ProgressBar1.Smooth:=true;   
      ProgressBar1.Max:=max;   
      ProgressBar1.Parent:=form;   
      ProgressBar1.Height:=20;   
      ProgressBar1.Width:=250;   
      ProgressBar1.Left:=5;   
      ProgressBar1.Top:=5;   
      ProgressBar1.Step:=1;   
      form.Show;   
      result:=ProgressBar1;   
  end;

Answer 2

unit DBGridExport;
interface
uses
  SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, Db, DBGrids, Comobj, extctrls, comctrls, ActiveX;
type
  TSpaceMark = (csComma, csSemicolon, csTab, csBlank, csEnter);
  TDBGridExport = class(TComponent)
  private
    FDB_Grid: TDBGrid; {读取DBGrid的源}
    FTxtFileName: string; {文本文件名}
    FSpaceMark: TSpaceMark; {间隔符号}
    FSpace_Ord: Integer; {间隔符号的Asc数值}
    FTitle: string; {显示的标题}
    FSheetName: string; {工作表标题}
    FExcel_Handle: OleVariant; {Excel的句柄}
    FWorkbook_Handle: OleVariant; {书签的句柄}
    FShow_Progress: Boolean; {是否显示插入进度}
    FProgress_Form: TForm; {进度窗体}
    FRun_Excel_Form: TForm; {启动Excel提示窗口}
    FProgressBar: TProgressBar; {进度条}
    function Connect_Excel: Boolean; {启动Excel}
    function New_Workbook: Boolean; {插入新的工作博}
    function InsertData_To_Excel: Boolean; {插入数据}
    procedure Create_ProgressForm(AOwner: TComponent); {创建进度显示窗口}
    procedure Create_Run_Excel_Form(AOwner: TComponent); {创建启动Excel窗口}
    procedure SetSpaceMark(Value: TSpaceMark); {设置导出时的间隔符号}
    protected
  public
    constructor Create(AOwner: TComponent); override; {新建}
    destructor Destroy; override; {销毁}
    function Export_To_Excel: Boolean; overload; {导出到Excel中}
    function Export_To_Excel(DB_Grid: TDBGrid): Boolean; overload;
    function Export_To_Txt(NewFile: Boolean = True): Boolean; overload; {导出到文本文件中}
    function Export_To_Txt(FileName: string; NewFile: Boolean = True): Boolean; overload;
    function Export_To_Txt(DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean; overload;
    function Export_To_Txt(FileName: string; DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean; overload;
    published
    property DB_Grid: TDBGrid read FDB_Grid write FDB_Grid;
    property Show_Progress: Boolean read FShow_Progress write FShow_Progress;
    property TxtFileName: string read FTxtFileName write FTxtFileName;
    property SpaceMark: TSpaceMark read FSpaceMark write SetSpaceMark;
    property Title: string read FTitle write FTitle;
    property SheetName: string read FSheetName write FSheetName;
end;procedure Register;implementationprocedure Register;begin
  RegisterComponents('Stone', [TDBGridExport]);
end;
{-------------------------------------------------------------------------------}
{新建}
constructor TDBGridExport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FShow_Progress := True;
  FSpaceMark := csTab;
end;{销毁}
destructor TDBGridExport.Destroy;
begin
  varClear(FExcel_Handle);
  varClear(FWorkbook_Handle);
inherited Destroy;
end;
{===============================================================================}
{导出到文本文件中}
function TDBGridExport.Export_To_Txt(NewFile: Boolean = True): Boolean;
var
  Txt: TStrings;
  Tmp_Str,data_Str,Column_name: string;
  i, j: Integer;
  Data_Set: TDataSet;
  book: pointer;
  Before_Scroll, Afrer_Scroll: TDataSetNotifyEvent;
begin
  Result := False;
  if NewFile = True then
    FTxtFileName := '';
  if FTxtFileName = '' then
  begin
    with TSaveDialog.Create(nil) do
    begin
      Title := '请选择输出文件名';
      DefaultExt := 'txt';
      Filter := '文本文件(*.Txt)|*.txt';
      Options := [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofNoReadOnlyReturn, ofEnableSizing];
      if Execute then
        FTxtFileName := FileName;
      Free;
      if FTxtFileName = '' then {如果没有选中文件，则直接推出}
      exit;
    end;    if FTxtFileName = '' then
    begin
      raise exception.Create('没有指定输出文件');
      Exit;
    end;
  end;
  if FDB_Grid = nil then
    raise exception.Create('请输入DBGrid名称');
  Txt := TStringList.Create;
  try{显示插入进度}
    if FShow_Progress = True then
    begin
      Create_ProgressForm(nil);
      FProgress_Form.Show;
    end;
    {第一行，插入标题}
    Tmp_Str := ''; //FDB_Grid.Columns[0].Title.Caption;
    for i := 1 to FDB_Grid.Columns.Count do
    if FDB_Grid.Columns[i - 1].Visible = True then
      Tmp_Str := Tmp_Str + FDB_Grid.Columns[i - 1].Title.Caption + Chr(FSpace_Ord);
    Tmp_Str := Copy(Tmp_Str, 1, Length(Tmp_Str) - 1);
    Txt.Add(Tmp_Str);
    {插入DBGrid中的数据}
    Data_Set := FDB_Grid.DataSource.DataSet;
    {记忆当前位置并取消任何事件}
    // new(book);
    book := Data_Set.GetBook;
    Data_Set.DisableControls;
    Before_Scroll := Data_Set.BeforeScroll;
    Afrer_Scroll := Data_Set.AfterScroll;
    Data_Set.BeforeScroll := nil;
    Data_Set.AfterScroll := nil;
    if FShow_Progress = True then
    begin
      Data_Set.Last;
      FProgress_Form.Refresh;
      FProgressBar.Max := Data_Set.RecordCount;
    end;
    {插入DBGrid中的所有字段}
    Data_Set.First;
    j := 2;
    while not Data_Set.Eof do
    begin
      if FShow_Progress = True then
        FProgressBar.Position := j - 2;
      Column_name := FDB_Grid.Columns[0].FieldName;
      Tmp_Str := ''; //Data_Set.FieldByName(Column_name).AsString;
      for i := 1 to FDB_Grid.Columns.Count do
        if FDB_Grid.Columns[i - 1].Visible = True then
        begin
          data_Str := FDB_Grid.Fields[i - 1].DisplayText;
          Tmp_Str := Tmp_Str + data_Str + Chr(FSpace_Ord);
        end;
      Tmp_Str := Copy(Tmp_Str, 1, Length(Tmp_Str) - 1);
      Txt.Add(Tmp_Str);
      j := j + 1;
      Data_Set.Next;
    end;
    {恢复原始事件以及标志位置}
    Data_Set.GotoBook(book);
    Data_Set.FreeBook(book);
    // dispose(book);
    Data_Set.EnableControls;
    Data_Set.BeforeScroll := Before_Scroll;
    Data_Set.AfterScroll := Afrer_Scroll;
    {写到文件}
    Txt.SaveToFile(FTxtFileName);
    Result := True;
  finally
    Txt.Free;
    if FShow_Progress = True then
    begin
      FProgress_Form.Free;
      FProgress_Form := nil;
    end;
  end;
end;

Answer 3

function TDBGridExport.Export_To_Txt(FileName: string; NewFile: Boolean = True): Boolean;
begin
  FTxtFileName := FileName;
  Result := Export_To_Txt(NewFile);
end;function TDBGridExport.Export_To_Txt(DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean;
begin
  FDB_Grid := DB_Grid;
  Result := Export_To_Txt(NewFile);
end;function TDBGridExport.Export_To_Txt(FileName: string; DB_Grid: TDBGrid; NewFile: Boolean = True): Boolean;
begin
  FTxtFileName := FileName;
  FDB_Grid := DB_Grid;
  Result := Export_To_Txt(NewFile);
end;
{-------------------------------------------------------------------------------}
{设置导出时的间隔符号}
procedure TDBGridExport.SetSpaceMark(Value: TSpaceMark);
begin
  FSpaceMark := Value;
  case Value of
    csComma: FSpace_Ord := ord(',');
    csSemicolon: FSpace_Ord := ord(';');
    csTab: FSpace_Ord := 9;
    csBlank: FSpace_Ord := 32;
    csEnter: FSpace_Ord := 13;
  end;
end;
{===============================================================================}
{导出到Excel中}
function TDBGridExport.Export_To_Excel: Boolean;
begin
  if FDB_Grid = nil then
    raise exception.Create('请输入DBGrid名称');
  Result := False;
  if Connect_Excel = True then
    if New_Workbook = True then
      if InsertData_To_Excel = True then
  Result := True;
end;function TDBGridExport.Export_To_Excel(DB_Grid: TDBGrid): Boolean;
begin
  FDB_Grid := DB_Grid;
  Result := Export_To_Excel;
end;
{-------------------------------------------------------------------------------}
{启动Excel}
function TDBGridExport.Connect_Excel: Boolean;
  {连接Ole对象}
  function My_GetActiveOleObject(const ClassName: string; out Ole_Handle: IDispatch): Boolean;
  var //IDispatch
    ClassID: TCLSID;
    Unknown: IUnknown;
    l_Result: HResult;
  begin
    Result := False;
    l_Result := CLSIDFromProgID(PWideChar(WideString(ClassName)), ClassID);
    if (l_Result and $80000000) = 0 then
    begin
      l_Result := GetActiveObject(ClassID, nil, Unknown);
      if (l_Result and $80000000) = 0 then
      begin
        l_Result := Unknown.QueryInterface(IDispatch, Ole_Handle);
        if (l_Result and $80000000) = 0 then
          Result := True;
      end;
    end;
  end;
  {创建OLE对象}
  function My_CreateOleObject(const ClassName: string; out Ole_Handle: IDispatch): Boolean;
  var
    ClassID: TCLSID;
    l_Result: HResult;
  begin
    Result := False;
    l_Result := CLSIDFromProgID(PWideChar(WideString(ClassName)), ClassID);
    if (l_Result and $80000000) = 0 then
    begin
      l_Result := CoCreateInstance(ClassID, nil, CLSCTX_INPROC_SERVER or
      CLSCTX_LOCAL_SERVER, IDispatch, Ole_Handle);
      if (l_Result and $80000000) = 0 then
        Result := True;
    end;
  end;
var
  l_Excel_Handle: IDispatch;
begin
  if FShow_Progress = True then
  begin
    Create_Run_Excel_Form(nil);
    FRun_Excel_Form.Show;
  end;
  if My_GetActiveOleObject('Excel.Application', l_Excel_Handle) = False then
    if My_CreateOleObject('Excel.Application', l_Excel_Handle) = False then
    begin
      FRun_Excel_Form.Free;
      FRun_Excel_Form := nil;
      raise exception.Create('启动Excel失败，可能没有安装Excel！');
      Result := False;
      Exit;
    end;
    FExcel_Handle := l_Excel_Handle;
    if FShow_Progress = True then
    begin
      FRun_Excel_Form.Free;
      FRun_Excel_Form := nil;
    end;
    Result := True;
end;
{插入新的工作博}
function TDBGridExport.New_Workbook: Boolean;
var
  i: Integer;
begin
  Result := True;
  try
    FWorkbook_Handle := FExcel_Handle.Workbooks.Add;
  except
    raise exception.Create('新建Excel工作表出错！');
    Result := False;
    Exit;
  end;
  if FTitle <> '' then
    FWorkbook_Handle.Application.ActiveWindow.Caption := FTitle;
  if FSheetName <> '' then
  begin
    for i := 2 to FWorkbook_Handle.Sheets.Count do
      if FSheetName = FWorkbook_Handle.Sheets[i].Name then
      begin
        raise exception.Create('工作表命名重复！');
        Result := False;
        exit;
      end;
    try
      FWorkbook_Handle.Sheets[1].Name := FSheetName;
    except
      raise exception.Create('工作表命名错误！');
      Result := False;
      exit;
    end;
  end;
end;
{插入数据}
function TDBGridExport.InsertData_To_Excel: Boolean;
var
  i, j, k: Integer;
  data_Str: string;
  Column_name: string;
  Data_Set: TDataSet;
  book: pointer;
  Before_Scroll, Afrer_Scroll: TDataSetNotifyEvent;
begin
  try
    {显示插入进度}
    if FShow_Progress = True then
    begin
      Create_ProgressForm(nil);
      FProgress_Form.Show;
    end;
    {第一行，插入标题}{仅仅插入可见数据}
    j := 1;
    for i := 1 to FDB_Grid.Columns.Count do
      if FDB_Grid.Columns[i - 1].Visible = True then
      begin
        FWorkbook_Handle.WorkSheets[1].Cells[1, j].Value := FDB_Grid.Columns[i - 1].Title.Caption;
        FWorkbook_Handle.WorkSheets[1].Columns[j].ColumnWidth := FDB_Grid.Columns[i - 1].Width div 6;
        j := j + 1
      end;
    {插入DBGrid中的数据}
    Data_Set := FDB_Grid.DataSource.DataSet;
    {记忆当前位置并取消任何事件}
    // new(book);
    book := Data_Set.GetBook;
    Data_Set.DisableControls;
    Before_Scroll := Data_Set.BeforeScroll;
    Afrer_Scroll := Data_Set.AfterScroll;
    Data_Set.BeforeScroll := nil;
    Data_Set.AfterScroll := nil;
    if FShow_Progress = True then
    begin
      Data_Set.Last;
      FProgress_Form.Refresh;
      FProgressBar.Max := Data_Set.RecordCount;
    end;
    Data_Set.First;
    k := 2;
    while not Data_Set.Eof do
    begin
      if FShow_Progress = True then
        FProgressBar.Position := k;
      j := 1;
      for i := 1 to FDB_Grid.Columns.Count do
      begin
        if FDB_Grid.Columns[i - 1].Visible = True then
        begin
          Column_name := FDB_Grid.Columns[i - 1].FieldName;
          data_Str := FDB_Grid.Fields[i - 1].DisplayText;
          FWorkbook_Handle.WorkSheets[1].Cells[k, j].Value := data_Str;
          j := j + 1;
          end;
      end;
      k := k + 1;
      Data_Set.Next;
    end;
    {恢复原始事件以及标志位置}
    Data_Set.GotoBook(book);
    Data_Set.FreeBook(book);
    // dispose(book);
    Data_Set.EnableControls;
    Data_Set.BeforeScroll := Before_Scroll;
    Data_Set.AfterScroll := Afrer_Scroll;
    Result := True;
  finally
    FExcel_Handle.Visible := True;
    FExcel_Handle.Application.ScreenUpdating := True;
    if FShow_Progress = True then
    begin
      FProgress_Form.Free;
      FProgress_Form := nil;
    end;
  end;
end;

Answer 4

{===============================================================================}
{启动Excel时给出进度显示}
procedure TDBGridExport.Create_Run_Excel_Form(AOwner: TComponent);
var
  Panel: TPanel;
  Prompt: TLabel; {提示的标签}
begin
  if assigned(FRun_Excel_Form) then exit;
    FRun_Excel_Form := TForm.Create(AOwner);
  with FRun_Excel_Form do
  begin
    try
      Font.Name := '宋体'; {设置字体}
      Font.Size := 9;
      BorderStyle := bsNone;
      Width := 300;
      Height := 100;
      BorderWidth := 2;
      Color := clBlue;
      Position := poScreenCenter;
      Panel := TPanel.Create(FRun_Excel_Form);
      with Panel do
      begin
        Parent := FRun_Excel_Form;
        Align := alClient;
        BevelInner := bvNone;
        BevelOuter := bvRaised;
        Caption := '';
      end;
      Prompt := TLabel.Create(Panel);
      with Prompt do
      begin
        Parent := panel;
        AutoSize := True;
        Left := 25;
        Top := 25;
        Caption := '正在导出数据，请稍候……';
      end;
    except
    end;
  end;
end;
{===============================================================================}
{创建进度显示窗口}
procedure TDBGridExport.Create_ProgressForm(AOwner: TComponent);
var
  Panel: TPanel;
  Prompt: TLabel; {提示的标签}
begin
  if assigned(FProgress_Form) then exit;
    FProgress_Form := TForm.Create(AOwner);
  with FProgress_Form do
  begin
    try
      Font.Name := '宋体'; {设置字体}
      Font.Size := 9;
      BorderStyle := bsNone;
      Width := 300;
      Height := 100;
      BorderWidth := 2;
      Color := clBlue;
      Position := poScreenCenter;
      Panel := TPanel.Create(FProgress_Form);
      with Panel do
        begin
        Parent := FProgress_Form;
        Align := alClient;
        BevelInner := bvNone;
        BevelOuter := bvRaised;
        Caption := '';
      end;
      Prompt := TLabel.Create(Panel);
      with Prompt do
      begin
        Parent := panel;
        AutoSize := True;
        Left := 25;
        Top := 25;
        Caption := '正在导出数据，请稍候……';
      end;
      FProgressBar := TProgressBar.Create(panel);
      with FProgressBar do
      begin
        Parent := panel;
        Left := 20;
        Top := 50;
        Height := 18;
        Width := 260;
      end;
    except
    end;
  end;
end;
end.

Answer 5

新建一个package 然后把这个unit添加到你的package 然后编译，留着用吧