自己写的从DBGRID导入EXCEL的程序，为什么只能导25个字段，多了就不行。实在没办法了，请高手指点。谢谢！！

Question

unit fun_LoadToExcel;interface
uses DBGrids,db,dbTables,Excel97,Forms, Grids,Sysutils,windows,comctrls,ComObj;
type  TShowByExcelEnter3=procedure (AstrSQL:widestring;IsXP:boolean);//*****************接            口************
//从DBGRID导入EXCEL，ATitle：报表标题，没有传空字符串
procedure DBGridToExcel(ADBGrid:TDBGrid;ATitle:string);
//******************************************
function SetExcel(ARange:Range):Boolean;implementation
function SetExcel(ARange:Range):Boolean;
Begin
  ARange.Select;
    With ARange Do
      Begin
        HorizontalAlignment := xlCenter;
        VerticalAlignment := xlCenter;
        WrapText := False;
        Orientation := 0;
        AddIndent := False;
        IndentLevel := 0;
        ShrinkToFit := False;
        ReadingOrder := xlContext;
        MergeCells := False;
        Merge(0);
        NumberFormatLocal := '@';
        EntireColumn.AutoFit;
      End;
  With ARange.Borders Do
    Begin
      LineStyle := xlContinuous;
    End ;
  Result := true;
End;
procedure DBGridToExcel(ADBGrid:TDBGrid;ATitle:string);
var
  IRange : Excel97.Range ;
  i    : integer ;
  exc_EApplication: TExcelApplication;
  p:Integer;
  ExcelSheet:Variant;begin
  exc_EApplication := Excel97.TExcelApplication.Create( Application ) ;
  try
    exc_EApplication.Visible[0] := True;
  except
    if Assigned(exc_EApplication) then
      exc_EApplication.Destroy;
    Exit;
  end;  try
    exc_EApplication.Workbooks.Add( NULL , 0 ) ;
//设置表格标题
   if ATitle<>'' then
   begin
     IRange := exc_EApplication.ActiveCell ;
     IRange.Value :=ATitle;
     SetExcel(exc_EApplication.Range['A1',Chr(65+ADBGrid.Columns.Count-1)+'1']);     IRange := exc_EApplication.Range[ 'A2', 'A2'] ;
     p:=3;
   end
   else
   begin
      IRange := exc_EApplication.ActiveCell ;
      p:=2;
    end;
//设置字段标题    for i:=0 to ADBGrid.Columns.Count-1 do
    begin
      SetExcel(IRange);
      IRange.Value := ADBGrid.Columns[i].Title.Caption;  //ADBGrid.Fields[i].AsString ;
      IRange := IRange.Next ;
    end;
//设置字段值
    ADBGrid.DataSource.DataSet.First ;    while not ADBGrid.DataSource.DataSet.Eof do
    begin
      IRange := exc_EApplication.Range[ 'A' + inttostr(p), 'A' + inttostr(p)] ;
      p := p +1 ;
      for i:=0 to ADBGrid.Columns.Count-1 do
      begin
      SetExcel(IRange);
        IRange.Value := ADBGrid.Fields[i].asstring ;
        IRange := IRange.Next ;
      end;
      ADBGrid.DataSource.DataSet.Next ;
    end;    exc_EApplication.Disconnect ;
  except
    exc_EApplication.Disconnect ;
  end;
end;end.

Answer 1

//------------------------------------------------------------------------------
// StringGrid导出为Excel，你参考一下吧
//------------------------------------------------------------------------------
procedure TForm1.btnSaveToExcClick(Sender: TObject);
var
  XLSApp: Variant;
  I, J: Integer;
  saveName: string;
begin
  if dlgSave1.Execute then
    saveName := dlgSave1.FileName
  else
    Exit;  try
    Screen.Cursor := crHourGlass;    try
      XLSApp := CreateOleObject('Excel.Application');
      XLSApp.WorkBooks.Add;
      XLSApp.workBooks[1].WorkSheets[1].Name := '2007 all';
    except
      ShowMessage('no excel install!');
      Exit;
    end;    for I:=0 to strGrd1.ColCount - 1 do
      for j:=0 to strGrd1.RowCount - 1 do
        XLSApp.workBooks[1].WorkSheets[1].Cells[J+1,I+1] := Trim(strGrd1.cells[I,J]);    XLSApp.ActiveWorkBook.SaveAs(saveName);
    XLSApp.workBooks.close;
    XLSApp.quit;
  Finally
    Screen.Cursor := crDefault;
  end;
end;

Answer 2

找到了段代码，执行还比我的快 爽啊！
{
功能描述：把DBGrid输出到Excel表格（支持多Sheet）
调用格式：CopyDbDataToExcel([DBGrid1, DBGrid2]);
}
procedure CopyDbDataToExcel(Args: array of const);
var
  iCount, jCount: Integer;
  XLApp: Variant;
  Sheet: Variant;
  I: Integer;
begin
  Screen.Cursor := crHourGlass;
  if not VarIsEmpty(XLApp) then
  begin
    XLApp.DisplayAlerts := False;
    XLApp.Quit;
    VarClear(XLApp);
  end;  try
    XLApp := CreateOleObject(‘Excel.Application‘);
  except
    Screen.Cursor := crDefault;
    Exit;
  end;  XLApp.WorkBooks.Add;
  XLApp.SheetsInNewWorkbook := High(Args) + 1;  for I := Low(Args) to High(Args) do
  begin
    XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name;
    Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];    if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then
    begin
      Screen.Cursor := crDefault;
      Exit;
    end;    TDBGrid(Args[I].VObject).DataSource.DataSet.first;
    for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
      Sheet.Cells[1, iCount + 1] :=
    TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;    jCount := 1;
    while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do
    begin
      for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
        Sheet.Cells[jCount + 1, iCount + 1] :=
      TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString;      Inc(jCount);
      TDBGrid(Args[I].VObject).DataSource.DataSet.Next;
    end;
    XlApp.Visible := True;
  end;
  Screen.Cursor := crDefault;
end;