DbGridEh导出excel，记录太多会出错？

先打開EXCEL再打開文件試下。實再不行導成CSV算了，可能是格式的問題。

到出为文本格式，再用excel打开～～

谢谢各位。我用的是3.6的，lovezypj你用的是哪个？这个是免费的吗？

看看这个导出有没有问题unit Unit_DBGridEhToExcel;interface
uses
  SysUtils, Variants, Classes, Graphics, Controls, Forms, Excel2000, ComObj,
  Dialogs, DB, DBGridEh, SUIThemes, SUIProgressBar, SUIImagePanel;type  TDBGridEhToExcel = class(TComponent)
  private
    FProgressForm: TForm;                                  {进度窗体}
    FtempGauge: TsuiProgressBar;                           {进度条}
    FShowProgress: Boolean;                                {是否显示进度窗体}
    FShowOpenExcel:Boolean;                                {是否导出后打开Excel文件}
    FDBGridEh: TDBGridEh;
    FTitleName: TCaption;                                  {Excel文件标题}
    FUserName: TCaption;                                   {制表人}
    procedure SetShowProgress(const Value: Boolean);       {是否显示进度条}
    procedure SetShowOpenExcel(const Value: Boolean);      {是否打开生成的Excel文件}
    procedure SetDBGridEh(const Value: TDBGridEh);
    procedure SetTitleName(const Value: TCaption);         {标题名称}
    procedure SetUserName(const Value: TCaption);          {使用人名称}
    procedure CreateProcessForm(AOwner: TComponent);       {生成进度窗体}
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ExportToExcel; {输出Excel文件}
  published
    property DBGridEh: TDBGridEh read FDBGridEh write SetDBGridEh;
    property ShowProgress: Boolean read FShowProgress write SetShowProgress;    //是否显示进度条
    property ShowOpenExcel: Boolean read FShowOpenExcel write SetShowOpenExcel; //是否打开Excel
    property TitleName: TCaption read FTitleName write SetTitleName;
    property UserName: TCaption read FUserName write SetUserName;
  end;implementationconstructor TDBGridEhToExcel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FShowProgress := True;
  FShowOpenExcel:= True;
end;procedure TDBGridEhToExcel.SetShowProgress(const Value: Boolean);
begin
  FShowProgress := Value;
end;procedure TDBGridEhToExcel.SetDBGridEh(const Value: TDBGridEh);
begin
  FDBGridEh := Value;
end;procedure TDBGridEhToExcel.SetTitleName(const Value: TCaption);
begin
  FTitleName := Value;
end;procedure TDBGridEhToExcel.SetUserName(const Value: TCaption);
begin
  FUserName := Value;
end;procedure TDBGridEhToExcel.ExportToExcel;
var
  XLApp: Variant;
  Sheet: Variant;
  s1, s2: string;
  Caption: String;
  Row, Col: integer;
  iCount, jCount: Integer;
  FBookMark: TBook;
  FileName: String;
  SaveDialog1: TSaveDialog;
begin
    //如果数据集为空或没有打开则退出
    if not DBGridEh.DataSource.DataSet.Active then  Exit;    SaveDialog1 := TSaveDialog.Create(Nil);
    SaveDialog1.FileName := TitleName + '_' + FormatDateTime('YYMMDD', Date);
    SaveDialog1.Filter := 'Excel文件|*.xls';
    if SaveDialog1.Execute then
        FileName := SaveDialog1.FileName;
    SaveDialog1.Free;
    if FileName = '' then  Exit;    Application.ProcessMessages;    Screen.Cursor := crHourGlass;
    //显示进度窗体
    if ShowProgress then
        CreateProcessForm(nil);

    if not VarIsEmpty(XLApp) then
    begin
        XLApp.DisplayAlerts := False;
        XLApp.Quit;
        VarClear(XLApp);
    end;    //通过ole创建Excel对象
    try
        XLApp := CreateOleObject('Excel.Application');
    except
        MessageDlg('创建Excel对象失败，请检查你的系统是否正确安装了Excel软件！', mtError, [mbOk], 0);
        Screen.Cursor := crDefault;
        Exit;
    end;    //生成工作页
    XLApp.WorkBooks.Add[XLWBatWorksheet];
    XLApp.WorkBooks[1].WorkSheets[1].Name := TitleName;
    Sheet := XLApp.Workbooks[1].WorkSheets[TitleName];    //写标题
    sheet.cells[1, 1] := TitleName;
    sheet.range[sheet.cells[1, 1], sheet.cells[1, DBGridEh.Columns.Count]].Select;  //选择该列
    XLApp.selection.HorizontalAlignment := $FFFFEFF4;                               //居中
    XLApp.selection.MergeCells := True;                                             //合并    //写表头
    Row := 1;
    jCount := 3;
    for iCount := 0 to DBGridEh.Columns.Count - 1 do
    begin
        Col := 2;
        Row := iCount+1;
        Caption := DBGridEh.Columns[iCount].Title.Caption;
        while POS('|', Caption) > 0 do
        begin
            jCount := 4;
            s1 := Copy(Caption, 1, Pos('|',Caption)-1);
            if s2 = s1 then
            begin
                sheet.range[sheet.cells[Col, Row-1],sheet.cells[Col, Row]].Select;
                XLApp.selection.HorizontalAlignment := $FFFFEFF4;
                XLApp.selection.MergeCells := True;
            end
            else
                Sheet.cells[Col,Row] := Copy(Caption, 1, Pos('|',Caption)-1);
            Caption := Copy(Caption,Pos('|', Caption)+1, Length(Caption));
            Inc(Col);
            s2 := s1;
        end;
        Sheet.cells[Col, Row] := Caption;
        Inc(Row);
    end;    //合并表头并居中
    if jCount = 4 then
        for iCount := 1 to DBGridEh.Columns.Count do
            if Sheet.cells[3, iCount].Value = '' then
            begin
                sheet.range[sheet.cells[2, iCount],sheet.cells[3, iCount]].Select;
                XLApp.selection.HorizontalAlignment := $FFFFEFF4;
                XLApp.selection.MergeCells := True;
            end
            else begin
                sheet.cells[3, iCount].Select;
                XLApp.selection.HorizontalAlignment := $FFFFEFF4;
            end;    //读取数据
    DBGridEh.DataSource.DataSet.DisableControls;
    FBookMark := DBGridEh.DataSource.DataSet.GetBook;
    DBGridEh.DataSource.DataSet.First;
    while not DBGridEh.DataSource.DataSet.Eof do
    begin
        for iCount := 1 to DBGridEh.Columns.Count do
          Sheet.cells[jCount, iCount] := DBGridEh.Columns.Items[iCount-1].Field.AsString;
        Inc(jCount);        //显示进度条进度过程
        if ShowProgress then
        begin
            FtempGauge.Position := DBGridEh.DataSource.DataSet.RecNo;
            FtempGauge.Refresh;
        end;        DBGridEh.DataSource.DataSet.Next;
    end;
    if DBGridEh.DataSource.DataSet.BookValid(FBookMark) then
        DBGridEh.DataSource.DataSet.GotoBook(FBookMark);
    DBGridEh.DataSource.DataSet.EnableControls;    //读取表脚
    if DBGridEh.FooterRowCount > 0 then
    begin
        for Row := 0 to DBGridEh.FooterRowCount-1 do
        begin
            for Col := 0 to DBGridEh.Columns.Count-1 do
                Sheet.cells[jCount, Col+1] := DBGridEh.GetFooterValue(Row,DBGridEh.Columns[Col]);
            Inc(jCount);
        end;
    end;    //调整列宽
    for iCount := 1 to DBGridEh.Columns.Count do
        Sheet.Columns[iCount].EntireColumn.AutoFit;    sheet.cells[1, 1].Select;
    XlApp.Workbooks[1].SaveAs(FileName);    XlApp.Visible := True;
    XlApp := Unassigned;    if ShowProgress then
        FreeAndNil(FProgressForm);
    Screen.Cursor := crDefault;

end;destructor TDBGridEhToExcel.Destroy;
begin
  inherited Destroy;
end;end.

procedure TDBGridEhToExcel.CreateProcessForm(AOwner: TComponent);
var
  Panel: TsuiPanel;
begin
  if Assigned(FProgressForm) then
     exit;  FProgressForm := TForm.Create(AOwner);
  with FProgressForm do
  begin
    try
      Font.Name := '宋体';                                  {设置字体}
      Font.Size := 10;
      BorderStyle := bsNone;
      Width := 300;
      Height := 60;
      BorderWidth := 1;
      Color := clBlack;
      Position := poScreenCenter;
      Panel := TsuiPanel.Create(FProgressForm);
      with Panel do
      begin
        Parent := FProgressForm;
        Align := alClient;
        Caption := '正在导出Excel，请稍候......';
        UIStyle:=WinXP;
        Color:=$00E9E5E0;
     end;
      FtempGauge:=TsuiProgressBar.Create(Panel);
      with FtempGauge do
      begin
        Parent := Panel;
        Align:=alClient;
        UIStyle:=MacOS;
        Min := 0;
        Max:= DBGridEh.DataSource.DataSet.RecordCount;
        Position := 0;
      end;
    except    end;
  end;
  FProgressForm.Show;
  FProgressForm.Update;
end;procedure TDBGridEhToExcel.SetShowOpenExcel(const Value: Boolean);
begin
   FShowOpenExcel:=Value;
end;

谢谢各位大侠，hongqi162 的这个方法测试正常，但导出的时间太长了，10分钟的时间。
大家用的EhLib是哪个版本呢？我用3.6版本在一台电脑上出现无法读取文件，另外一台电脑上没有这个错误，非常奇怪。

建CreateOleObject('Excel.Application'),再读数据写进Excel档看看.

我帮你贴一个,我也是抄的。我用的是DbGrid，没有dbGrideh的导入功能这个单元的功能是直接从 DataSet 导入的，经测试效果不错。unit untSaveExcelFile;interfaceUses
DB, Classes,Dialogs,controls;var
CXlsBof: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
CXlsEof: array[0..1] of Word = ($0A, 00);
CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
CXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
CXlsRk: array[0..4] of Word = ($27E, 10, 0, 0, 0);
CXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);Type
TDS2Excel = Class(TObject)
Private
   FCol: word;
   FRow: word;
   FDataSet: TDataSet;
   Stream: TStream;
   FWillWriteHead: boolean;
   FBookMark: TBook;
   procedure IncColRow;
   procedure WriteBlankCell;
   procedure WriteFloatCell(const AValue: Double);
   procedure WriteIntegerCell(const AValue: Integer);
   procedure WriteStringCell(const AValue: string);
   procedure WritePrefix;
   procedure WriteSuffix;
   procedure WriteTitle;
   procedure WriteDataCell;   procedure Save2Stream(aStream: TStream);
   procedure Save2File(FileName: string; WillWriteHead: Boolean);
Public
    procedure SaveFile(WillWriteHead: Boolean);
      Constructor Create(aDataSet: TDataSet);
end;implementationuses SysUtils;Constructor TDS2Excel.Create(aDataSet: TDataSet);
begin
inherited Create;
FDataSet := aDataSet;
end;procedure TDS2Excel.IncColRow;
begin
if FCol = FDataSet.FieldCount - 1 then
begin
   Inc(FRow);
   FCol :=0;
end
else
   Inc(FCol);
end;procedure TDS2Excel.WriteBlankCell;
begin
CXlsBlank[2] := FRow;
CXlsBlank[3] := FCol;
Stream.WriteBuffer(CXlsBlank, SizeOf(CXlsBlank));
IncColRow;
end;procedure TDS2Excel.WriteFloatCell(const AValue: Double);
begin
CXlsNumber[2] := FRow;
CXlsNumber[3] := FCol;
Stream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber));
Stream.WriteBuffer(AValue, 8);
IncColRow;
end;procedure TDS2Excel.WriteIntegerCell(const AValue: Integer);
var
V: Integer;
begin
CXlsRk[2] := FRow;
CXlsRk[3] := FCol;
Stream.WriteBuffer(CXlsRk, SizeOf(CXlsRk));
V := (AValue shl 2) or 2;
Stream.WriteBuffer(V, 4);
IncColRow;
end;procedure TDS2Excel.WriteStringCell(const AValue: string);
var
L: Word;
begin
L := Length(AValue);
CXlsLabel[1] := 8 + L;
CXlsLabel[2] := FRow;
CXlsLabel[3] := FCol;
CXlsLabel[5] := L;
Stream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
Stream.WriteBuffer(Pointer(AValue)^, L);
IncColRow;
end;procedure TDS2Excel.WritePrefix;
begin
Stream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
end;procedure TDS2Excel.WriteSuffix;
begin
Stream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
end;procedure TDS2Excel.WriteTitle;
var
n: word;
begin
for n := 0 to FDataSet.FieldCount - 1 do
   WriteStringCell(FDataSet.Fields[n].FieldName);
end;procedure TDS2Excel.WriteDataCell;
var
n: word;
begin
WritePrefix;
if FWillWriteHead then WriteTitle;
FDataSet.DisableControls;
FBookMark := FDataSet.GetBook;
FDataSet.First;
while not FDataSet.Eof do
begin
   for n := 0 to FDataSet.FieldCount - 1 do
   begin
     if FDataSet.Fields[n].IsNull then
       WriteBlankCell
     else begin
       case FDataSet.Fields[n].DataType of
         ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
             WriteIntegerCell(FDataSet.Fields[n].AsInteger);
         ftFloat, ftCurrency, ftBCD:
             WriteFloatCell(FDataSet.Fields[n].AsFloat);
       else
         WriteStringCell(FDataSet.Fields[n].AsString);
       end;
     end;
   end;
   FDataSet.Next;
end;
WriteSuffix;
if FDataSet.BookValid(FBookMark) then FDataSet.GotoBook(FBookMark);
FDataSet.EnableControls;
end;procedure TDS2Excel.Save2Stream(aStream: TStream);
begin
FCol := 0;
FRow := 0;
Stream := aStream;
WriteDataCell;
end;procedure TDS2Excel.Save2File(FileName: string; WillWriteHead: Boolean);
var
aFileStream: TFileStream;
begin
FWillWriteHead := WillWriteHead;
if FileExists(FileName) then
begin
   if MessAgeDlg('文件已存在,是否覆盖?',mtinformation,[mbyes,mbno],0)=MrYes then
    DeleteFile(FileName) else exit;
end; aFileStream := TFileStream.Create(FileName, fmCreate);
Try
   Save2Stream(aFileStream);
Finally
   aFileStream.Free;
end;
end;procedure TDS2Excel.SaveFile(WillWriteHead: Boolean);
var
SaveDialog1: TSaveDialog;
sName,sFileName:string;
begin
SaveDialog1 := TSaveDialog.Create(nil);
Try
   SaveDialog1.Filter := 'Excel文档|*.xls';
   SaveDialog1.InitialDir := 'D:\';    if not SaveDialog1.Execute then exit;
    sFileName:=SaveDialog1.FileName;
    if (length(sFilename)<=4) or (Uppercase(copy(sfileName,Length(sFileName)-3,4))<>'.XLS') then
    sfileName:=sFileName+'.XLS';    Save2File(SFileName, WillWriteHead) Finally
   SaveDialog1.Free;
end;
end;end.

這種慢是沒辦法的，通過OLE來操作本身的總是，不是月亮的問題。

uses
DBGridEhImpExpSaveDBGridEhToExportFile(TDBGridEhExportAsXLS,DBGridEh1,savefilename,true); //一句话搞定，速度超快。

调试易

DbGridEh导出excel，记录太多会出错？

解决方案 »