急!急!急!有谁知道从Delphi中导出Excel表时,如何使两个单元格合成一个单元格

Question

var
  ExcelRange: Excel2000.Range;
  ExcelApplication: Excel2000.TExcelApplication;begin
  ...
  Row := 1;
  ExcelRange.Value := '表名: ' + sTableName;
  ExcelRange := ExcelApplication.Range['A' + IntToStr(Row),
    'G' + IntToStr(Row)];
  ExcelRange.Merge(ExcelRange.Select);
end;

Answer 1

unit ExeclPrintF;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db,StdCtrls,ComObj,Grids,DBGrids,Variants;type
  TExeclPrintF = class(TDataSource)
  private
  //   FExeclFile: string;
     FDBGrid: TDBGrid;
     FTitle:string;
     FTitleline:integer;
     TitleCell:array[1..10,1..100] of string;
     Fsavefile:boolean;
     Ffilename:string;
//   procedure SetExeclFile(filename:string);
     procedure SetDBGride(Grid:TDBGrid);
     procedure SetTitle(titlestring:string);
     procedure SetTitleline(linenum:integer);
     Procedure ChangeRows;
     procedure SetSaveFile(issave:boolean);
     procedure SetFileName(name:string);    { Private declarations }
  protected
    { Protected declarations }
  public
    eclApp,WorkBook:Variant;
    { Public declarations }
  published
    procedure print;
    procedure EmptyTitleCell;
//  property ExeclFile:string read FExeclFile write SetExeclFile;
    procedure WriteTitleCell(Row:integer;Column:integer;Str:string);
    property DGride:TDBGrid read FDBGrid write SetDBGride;
    property Title:string read FTitle write SetTitle;
    property savefile:boolean read Fsavefile write SetSaveFile default false;
    property Titleline:integer read Ftitleline write SetTitleline default 0;
    property filename:string read Ffilename write SetFileName;
    { Published declarations }
  end;procedure Register;implementationprocedure Register;
begin
  RegisterComponents('Samples', [TExeclPrintF]);
end;
{
procedure TExeclPrintF.SetExeclFile(filename:string);
begin
  FExeclFile:=filename;
end;        }
procedure TExeclPrintF.SetTitle(titlestring:string);
begin
   FTitle:=titlestring;
end;procedure TExeclPrintF.SetTitleline(linenum:integer);
begin
   FTitleline:=linenum;
end;procedure TExeclPrintF.SetDBGride(Grid:TDBGrid);
begin
  FDBGrid:=grid;
end;
procedure TExeclPrintF.SetSaveFile(issave:boolean);
begin
  Fsavefile:=issave;
end;procedure TExeclPrintF.ChangeRows;
var
  ColumnRange:Variant;
begin
  ColumnRange:=eclApp.Workbooks[1].WorkSheets[1].Rows;
  ColumnRange.Rows.Item[FTitleline+1].Font.Bold:=True;
  ColumnRange.Rows[FTitleline+1].Font.Color:=clBlue;
  if FTitleline<>0 then
  begin
     ColumnRange.Rows.Item[1].Font.Bold:=True; // Item是指有内容的项，如果单用Rows[1]指整行
     ColumnRange.Rows[1].Font.Color:=clBlue;
     ColumnRange.Rows[1].Font.Size:=28;
  end;
end;procedure TExeclPrintF.EmptyTitleCell;
var
  i,j:integer;
begin
  for i:=1 to 10 do
    for j:=1 to 100 do
         TitleCell[i,j]:='';
end;procedure TExeclPrintF.WriteTitleCell(Row:integer;Column:integer;Str:string);
begin
  { if Ftitleline = 0 then exit;
   if Row>Ftitleline then exit;  }
     TitleCell[Row,Column]:=Str;end;procedure TExeclPrintF.print;
var
  //xlsFileName:string;
  i,j:integer;
  tlinenum:integer;
  ttitle:string;
  s:string;
 // filename:variant;
begin
 // xlsFileName:=FExeclFile;
  try
     eclApp:=CreateOleObject('Excel.Application');
     WorkBook:=CreateOleobject('Excel.Sheet');
  except
     ShowMessage('您的机器里未安装Microsoft Excel。');
     Exit;
  end;
  try
     tlinenum:=FTitleline+1;
     ttitle:=FTitle;
     if not Fsavefile then
        eclApp.Visible:=true
     else
        eclApp.Visible:=false;
     workBook:=eclApp.workBooks.Add();
   //  WorkBook.saveas(xlsFileName);
    // DataSet.First;
    { for i:=1 to DataSet.FieldCount-1 do
     begin
          eclApp.Cells(1,i+1):=DataSet.Fields[i].DisplayLabel;
     end;     for i:=1 to DataSet.RecordCount do
     begin
          for j:=0 to DataSet.FieldCount-1 do
              eclApp.Cells(i+1,j+1):=DataSet.Fields[j].AsString;
        DataSet.Next;
     end;  }
     {if tlinenum<>0 then
     begin
         i:=trunc(FDBGrid.Columns.Count/2);
         eclApp.Cells(1,3):=ttitle;
     end; }
     if FTitleline<>0 then
     begin
         for i:=1 to tlinenum do
         for j:=1 to 100 do
         begin
            if TitleCell[i,j]<>'' then
                eclApp.Cells(i,j):=TitleCell[i,j];
         end;
     end;
  //   showmessage('2');
     for i:=0 to FDBGrid.Columns.Count-1 do
     begin
     //    eclApp.Cells(1,i+1).ColumnWidth:=FDBGrid.Columns[i].Width;
         eclApp.Cells(tlinenum,i+1):=FDBGrid.Columns[i].Title.Caption;
     end;
  //   showmessage('3');
     FDBGrid.DataSource.DataSet.First;
     i:=tlinenum;
     //for i:=0 to FDBGrid.DataSource.DataSet.RecordCount-1 do
     while not FDBGrid.DataSource.DataSet.Eof do
     begin
         for j:=0 to FDBGrid.Columns.Count-1 do
         begin
              if FDBGrid.Columns[j].Field.DataType=ftDateTime then
                    s:=formatdatetime('yyyy-mm-dd hh:nn:ss',FDBGrid.Columns[j].Field.AsDateTime)
              else
                    s:=FDBGrid.Fields[j].Text;
              eclApp.Cells(i+1,j+1):=s;
         end;
         FDBGrid.DataSource.DataSet.Next;
         i:=i+1;
     end;
     ChangeRows;
//     WorkBook.close;
//   eclApp.Quit;
     if Fsavefile then
     begin
         if Ffilename<>'' then
         begin
                WorkBook.saveas(Ffilename);
                WorkBook.close;
         end;
     end;
     eclApp:=Unassigned;
  except
     ShowMessage('不能正确操作Excel文件。可能是该文件已被其他程序打开,或系统错误。');
     WorkBook.close;
     eclApp.Quit;
     eclApp:=Unassigned;
  end;
end;
procedure TExeclPrintF.SetFileName(name: string);
begin
   Ffilename:=name;
end;end.