delphi excel

dbgrid数据导出为excel

uses Excel2000,ComObj;

procedure F_Form.Button1Click(Sender: TObject);
var
    myExcel:TExcel;
    Int_i,Int_j,rowCount,columnCount:Integer;
    ExcelId:Variant;
begin
  try
      ExcelId:=CreateOleObject('Excel.Application');
  except
      on Exception do raise Exception.Create('无法创建报表,请确认是否安装EXCEL');
  end;

  if DBGrid4.DataSource.DataSet.RecordCount<>0 then
  begin
      rowCount:=DBGrid4.DataSource.DataSet.RecordCount;
      columnCount := DBGrid4.FieldCount;
        try
            Excelid.Visible := True;
            Excelid.WorkBooks.Add;
            Excelid.WorkSheets[1].Range['A1:I1'].Merge(True);
            Excelid.WorkSheets[1].Cells[1,1].Value :=  'xxx公司';

            Excelid.WorkSheets[1].Range['A2:I2'].Merge(True);
            Excelid.WorkSheets[1].Cells[2,1].Value := 'xxx信息统计表';

            excelid.worksheets[1].cells[3,1].value:='1;
            excelid.worksheets[1].cells[3,2].value:='2;
            excelid.worksheets[1].cells[3,3].value:='3';
            excelid.worksheets[1].cells[3,4].value:='4;
            excelid.worksheets[1].cells[3,5].value:='5;
            excelid.worksheets[1].cells[3,6].value:='6;
            excelid.worksheets[1].cells[3,7].value:='7;
            excelid.worksheets[1].cells[3,8].value:='8';
            excelid.worksheets[1].cells[3,9].value:='9;
            excelid.worksheets[1].cells[3,10].value:='10;

            Excelid.WorkSheets[1].Range['A1:T3'].Font.Name :='宋体';
            Excelid.WorkSheets[1].Range['A1:I2'].Font.Size :=12;
            Excelid.WorkSheets[1].Range['A2:T3'].Font.Size :=10;
            Excelid.WorkSheets[1].Range['A1:T3'].Font.Bold :=True;

            DBGrid4.DataSource.DataSet.First();
            for Int_i:=0 to rowCount do
            begin
              for Int_j:=0 to columnCount-1 do
              begin
                ExcelId.worksheets[1].cells[Int_i+4,int_j+1].value:=  DBGrid4.DataSource.DataSet.FieldByName(DBGrid4.Columns.Items[int_j].FieldName).AsString;
              end;
              DBGrid4.DataSource.DataSet.Next();
            end;

            Excelid.WorkSheets[1].range['A1:T3'].HorizontalAlignment := $FFFFEFF4;
            Excelid.worksheets[1].range['A1:T3'].VerticalAlignment := $FFFFEFF4;
            Excelid.Columns.AutoFit;

        finally
        end;

  end;
end;

View Code

从dbgrid导出数据保存成excel文件

实验了，很好用
function TForm1.ExportDBGrid(DBGrid: TDBGrid; SheetName: string): boolean;//直接保存，不显示EXCEL
var

c, r, i, j: integer;

app: Olevariant;

TempFileName, ResultFileName: string;

begin

try

    result := True;

      app := CreateOLEObject('Excel.application');

    // app.WorkBooks.Add(xlWBatWorkSheet);   

    except

      Application.MessageBox('Excel没有正确安装！','警告',MB_OK);

      result := False;

      exit;

    end;

    SaveDialog1.DefaultExt := 'xls';

    SaveDialog1.FileName := SheetName;

    if SaveDialog1.Execute then

      TempFileName := SaveDialog1.FileName

    else

      Exit;

    app.Workbooks.add;

    app.Visible := false;

    Screen.Cursor := crHourGlass;

    DBGrid.DataSource.DataSet.First;

    c := DBGrid.DataSource.DataSet.FieldCount;

    r := DBGrid.DataSource.DataSet.RecordCount;

    Application.ProcessMessages;

    for i := 0 to c - 1 do

      app.cells(1, 1 + i) := DBGrid.DataSource.DataSet.Fields[i].DisplayLabel;

    for j := 1 to r do

    begin

      for i := 0 to c - 1 do

        app.cells(j + 1, 1 + i) := DBGrid.DataSource.DataSet.Fields[i].AsString;

      DBGrid.DataSource.DataSet.Next;

    end;   

    ResultFileName := TempFileName;

    if ResultFileName = '' then

      ResultFileName := '数据导出';

    if FileExists(TempFileName) then

     DeleteFile(TempFileName);

    app.Activeworkbook.saveas(TempFileName);

    app.Activeworkbook.close(false);

    app.quit;

    app := unassigned;

end;

 

procedure TForm1.Button2Click(Sender: TObject);   //按钮保存

begin

try

    Screen.Cursor := crHourGlass;

    ExportDBGrid(DBGrid1, '导出数据');    //暂时将导出的文件名称为“导出数据”（的execl文件）   

finally

    Screen.Cursor := crDefault;

end;

end;

View Code

 

转载于:https://www.cnblogs.com/blogpro/p/11345551.html