我想点击botton1后把dbgrid中的数据导入EXECL表格。

解决方案 »

  1.   

    unit DBGridExport;interfaceuses
      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;
    //    FTxtFileName: string;
        FSpaceMark: TSpaceMark;
        FSpace_Ord: Integer;
        FTitle: string;
        FSheetName: string;
        FExcel_Handle: OleVariant;    FWorkbook_Handle: OleVariant;    FShow_Progress: Boolean;    FProgress_Form: TForm;
        FRun_Excel_Form: TForm;
        FProgressBar: TProgressBar;    function Connect_Excel: Boolean;
        function New_Workbook: Boolean;
        function InsertData_To_Excel: Boolean;
        procedure Create_ProgressForm(AOwner: TComponent);
        procedure Create_Run_Excel_Form(AOwner: TComponent);
        procedure SetSpaceMark(Value: TSpaceMark);
      protected
      public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        function Export_To_Excel: Boolean; overload;
        function Export_To_Excel(DB_Grid: TDBGrid): Boolean; overload;
      published
        property DB_Grid: TDBGrid read FDB_Grid write FDB_Grid;
        property Show_Progress: Boolean read FShow_Progress write FShow_Progress;
        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('Samples', [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;
      

  2.   

    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;{===============================================================================}function TDBGridExport.Export_To_Excel: Boolean;
    begin
      if FDB_Grid = nil then
        raise exception.Create('DBGrid not assigned');  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;
      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;  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;
        Application.ProcessMessages;
      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 not installed?');
          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('create Excel application Faile');
        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('Workbook Faile');
            Result := False;
            exit;
          end;
        try
          FWorkbook_Handle.Sheets[1].Name := FSheetName;
        except
          raise exception.Create('Create Sheet Fail');
          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;    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;
      

  3.   

    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;{===============================================================================}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 := '&sup2;&Oacute;&copy;ú&Aring;é';
          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 := '&yen;&iquest;&brvbar;b&frac34;&THORN;§@, &frac12;&ETH;&micro;y&shy;&Ocirc;...';
          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 := '&sup2;&Oacute;&copy;ú&Aring;é';
          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 := '&yen;&iquest;&brvbar;b&frac34;&THORN;§@, &frac12;&ETH;&micro;y&shy;&Ocirc;...';
          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.
      

  4.   

    我不明白啊,我要的点击botton后触发事件啊
    procedure TDBGridExport.Create_ProgressForm(AOwner: TComponent);
    procedure TDBGridExport.Create_Run_Excel_Form(AOwner: TComponent);unit DBGridExport;这些是什么意思?
      

  5.   

    我搜索的时候,看到一文章。如下procedure TfrmGlobal.DBGridInFoToExcel(FileName, TitleCaption: string;
      MakeDataSource: TDataSource; makeDBGrid: TDBGrid);
    var
         xlApp, xlSheet, szValue: Variant;
         ARow, iLoop: word;
    begin
         xlApp := CreateOleObject('Excel.Application');
         try
             xlSheet := CreateOleObject('Excel.Sheet');
             xlSheet := xlApp.WorkBooks.Add;
             
             // 主标题
              xlSheet.WorkSheets[1].Cells[1,1] := TitleCaption;
             
        //  表格标题     
             for iLoop := 0 to makeDBGridEh.Columns.Count - 1 do
                  xlSheet.WorkSheets[1].Cells[2, iLoop+1] := makeDBGridEh.Columns[iLoop].Title.Caption;         // 数据
             ARow := 3;
             with MakeDataSource.DataSet do
             begin
                  DisableControls;
                  First;
                  while not Eof do
                  begin
                       for iLoop := 0 to Fields.Count - 1 do
                       begin
                           szValue := Fields[iLoop].Value;
                           xlSheet.WorkSheets[1].Cells[ARow, iLoop+1] := szValue;
                       end;
                       Inc(ARow);
                       Next;
                  end;
                  First;
                  EnableControls;
             end;         try
                  xlSheet.SaveAs(FileName);
                  Application.MessageBox('导出完毕!', '提示', MB_IconExclamation);
             finally
                  xlSheet.Close;
                  xlApp.Quit;
                  xlApp := UnAssigned;
             end;
         except
              MessageBox(handle, '本机没有安装Excel.', '提示',MB_IconExclamation);
         end;end;
    ...
    uses Excel2000, {C:\Program Files\Borland\Delphi6\Imports}OleServer;procedure TFrmMain.WriteExcel(AdsData: TADODataSet; sName, Title: string);
    var
    ExcelApplication1: TExcelApplication;
    ExcelWorksheet1: TExcelWorksheet;
    ExcelWorkbook1: TExcelWorkbook; 
    i, j: integer; 
    filename: string;
    begin 
    filename := concat(extractfilepath(application.exename), sName, '.xls');
    try
    ExcelApplication1 := TExcelApplication.Create(Application); 
    ExcelWorksheet1 := TExcelWorksheet.Create(Application); 
    ExcelWorkbook1 := TExcelWorkbook.Create(Application); 
    ExcelApplication1.Connect; 
    except 
    Application.Messagebox('Excel 没有安装!', 'Hello', MB_ICONERROR + mb_Ok);
    Abort; 
    end; 
    try 
    ExcelApplication1.Workbooks.Add(EmptyParam, 0); 
    ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]); 
    ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _worksheet); 
    AdsData.First; 
    for j := 0 to AdsData.Fields.Count - 1 do 
    begin 
    ExcelWorksheet1.Cells.item[3, j + 1] := AdsData.Fields[j].DisplayLabel; 
    ExcelWorksheet1.Cells.item[3, j + 1].font.size := '10'; 
    end; 
    for i := 4 to AdsData.RecordCount + 3 do 
    begin 
    for j := 0 to AdsData.Fields.Count - 1 do 
    begin 
    ExcelWorksheet1.Cells.item[i, j + 1] :=AdsData.Fields[j].Asstring;
    ExcelWorksheet1.Cells.item[i, j + 1].font.size := '10';
    end; 
    AdsData.Next; 
    end;
    ExcelWorksheet1.Columns.AutoFit;
    ExcelWorksheet1.Cells.item[1, 2] := Title;
    ExcelWorksheet1.Cells.Item[1, 2].font.size :='14'; 
    ExcelWorksheet1.SaveAs(filename); 
    Application.Messagebox(pchar('数据成功导出' + filename), 'Hello',mb_Ok);
    finally 
    ExcelApplication1.Disconnect; 
    ExcelApplication1.Quit; 
    ExcelApplication1.Free; 
    ExcelWorksheet1.Free; 
    ExcelWorkbook1.Free; 
    end; 
    end;procedure Tfrmmain.FormCreate(Sender: TObject);
    begin
    WriteExcel(ADODataSet1, 'ergonge','hhh');
    end;可是我不明白
    procedure TfrmGlobal.DBGridInFoToExcel(FileName, TitleCaption: string;
      MakeDataSource: TDataSource; makeDBGrid: TDBGrid);
    这个是什么事件?
      

  6.   

    这里有一个实例
    是我用在自己的程序中的//这句放在工程头部
    uses comobj;   //这句需要,是加载需要的类以下是单击按钮btnExport的事件
    procedure Tfrmwhjh.btnExportClick(Sender: TObject);
    var //导出数据到Excel文件中
      eclapp,workbook:Variant;
      row:Integer;
    begin  begin
        try
          begin //生成一个Excel OleObject
            EclApp :=CreateOleObject('Excel.Application');
            WorkBook :=CreateOleObject('Excel.Sheet');
          end
        except //产生例外保存
          Application.MessageBox('您的机器里面没有安装任何版本的Excel!','提示信息',mb_ok+mb_iconwarning);
          Exit;
        end;    try
          workBook := EclApp.workBooks.Add;
          row := 2;
          EclApp.Workbooks.Item[1].Activate;
          eclApp.Cells.font.colorindex := 5;
          EclApp.Activesheet.Cells(1, 4) :=lblTitle.Caption;
          DSDisp.DataSet.First;
          EclApp.Activesheet.Cells(row, 1) := '台帐编号';
          EclApp.Activesheet.Cells(row, 2) := '设备名称';
          EclApp.Activesheet.Cells(row, 3) := '安装地点';
          EclApp.Activesheet.Cells(row, 4) := '维护级别';
          EclApp.Activesheet.Cells(row, 5) := '维护内容';      queryDisp.First;
          while not (queryDisp.Eof) do
          begin
            eclApp.Cells.Item[row + 1, 1] := queryDisp.FieldByName('台帐编号').AsString;
            eclApp.Cells.Item[row + 1, 2] := queryDisp.FieldByName('备品名称').AsString;
            eclApp.Cells.Item[row + 1, 3] := queryDisp.FieldByName('安装地点').AsString;
            eclApp.Cells.Item[row + 1, 4] := queryDisp.FieldByName('计划方式').AsString;
            eclApp.Cells.Item[row + 1, 5] := queryDisp.FieldByName('MaintenanceContent').AsString;
            queryDisp.Next;
            row := row + 1;
          end;
            //人员日期
            eclApp.Cells.Item[row + 1, 1] :='打印人员:';
            eclApp.Cells.Item[row + 1, 2] :=pubStrUserName;
            eclApp.Cells.Item[row + 1, 3] :='打印日期:';
            eclApp.Cells.Item[row + 1, 4] :=DateToStr(Date);      savedialog1.FileName:=pubStrTitle;
              if savedialog1.execute then //保存Excel文件
                begin
                WorkBook.saveas(savedialog1.filename);
                workBook.Saved := True;
                WorkBook.Close;
                eclApp.Quit;
                eclApp := Unassigned;
                Application.MessageBox('数据成功导出到EXCEL!','提示信息',mb_ok+mb_iconwarning);
                end;
        except
          Application.MessageBox('Excel文件保存失败!','提示信息',mb_ok+mb_iconwarning);
          WorkBook.close;
          eclApp.Quit;
          eclApp := Unassigned;
        end;
      end;
    end;
      

  7.   

    http://community.csdn.net/Expert/topic/3132/3132748.xml?temp=.7860681
      

  8.   

    to :  monglihong(难为) 
    procedure Tfrmwhjh.btnExportClick(Sender: TObject);
    这句中,Tfrmwhjh是什么东西?btnExport是不是第3 方控件?
      

  9.   

    uses ComObj;
    {$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
    var
      MSExcel:Variant;
      i,j:integer;
    begin
      SaveDialog1.Filter:='*.XLS|*.XLS';
      SaveDialog1.DefaultExt:='XLS';
      if SaveDialog1.Execute then
      begin
        MsExcel:=createOLEobject('excel.application');
        MsExcel.workBooks.add;
        Msexcel.visible:=false;
        with DataSource1.Dataset  do
        begin
          first;
          for i:=0 to fieldcount-1 do
          begin
            Msexcel.cells[1,i+1].value:=fields[i].DisplayLabel ;
          end;
          j:=2;
          while not eof do
          begin
            for i:=0 to fieldcount-1 do
            begin
              Msexcel.cells[j,i+1].numberformat:='@';
              Msexcel.cells[j,i+1].value:=fields[i].AsString ;
            end;
            inc(j);
            next;
          end;
        end;
        MSExcel.ActiveWorkBook.SaveAs(SaveDialog1.FileName);
        MSExcel.ActiveWorkBook.Saved:=True;
        MSExcel.Quit;
      end;
    end;
      

  10.   

    谢谢workers(玉蝴蝶),你的程序很清楚我把你的程序加了很多的容错处理,但是我还有一个问题,就是 :
    当dbgrid中无记录的时候,点击导入,程序错,所以我加了
    if dbgrid1.datasource1.dataset.recordcount = 0 then   ..............
    还是不行,主要是程序一开始,就点击导入的时候(dbgrid1中无记录)就出错。
    请问我因为怎样写程序?
      

  11.   

    对于你的问题
    应该这样写
    if not datasource1.dataset.isempty then{判断dbgrid的内容是否不为空}
    ...