Delphi Excel操作类

{****************************************************
//
Description :
  把一个表或Query或StringGrid中的数据保存到一个Execl文件中
Function List :
  创建接口
  procedure CreateExcelInstance;
  把表内容放到Excel文件中
  procedure TableToExcel( const Table: TTable );
  把Query内容放到Excel文件中
  procedure QueryToExcel( const Query: TQuery );
  把StringGrid内容放到Excel文件中
  procedure StringGridToExcel( const StringGrid: TStringGrid );
  保存为Execl文件
  procedure SaveToExcel( const FileName: String);

调用实例如下：
  OLEExcel1.CreateExcelInstance;
  OLEExcel1.QuerytoExcel((CurRep.DataSet as TQuery));
  OLEExcel1.SaveToExcel(SaveDlg1.FileName);
****************************************************}
Unit OleExcel;

Interface

Uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  comobj, DBTables, Grids, OleCtnrs, OleServer, Excel2000, Variants;
Type
  FileCheckResult = (fcrNotExistend, fcrNotXSLFile, fcrValidXSL); //文件不存在,不是XSL文件,合法的XSL文件
  TOLEExcel = Class(TComponent)
  Private
    FExcelCreated: Boolean;
    FVisible: Boolean;
    FExcel: Variant; //Excel程序对象
    FWorkBook: Variant; //Excel工作簿对象
    FWorkSheet: Variant; //Excel工作簿 工作表对象
    FCellFont: TFont; //单元格字体对象
    FTitleFont: TFont; //
    FFontChanged: Boolean;
    FIgnoreFont: Boolean;
    FFileName: TFileName;

    //********************************************自己添加*****************************//
    FCreateFromFile: Boolean; //指示是否打开已有文件
    FExcelCaption: String; //用程序打开Excel的窗体标

    //*********************************来自U_Report*****************************//
    FRCPrePage: Integer; //每页显示的记录数
    FMax: Integer; //最大的数组个数

    Procedure SetExcelCellFont(Var Cell: Variant);
    Procedure SetExcelTitleFont(Var Cell: Variant);
    Procedure GetTableColumnName(Const Table: TTable; Var Cell: Variant);
    Procedure GetQueryColumnName(Const Query: TQuery; Var Cell: Variant);
    Procedure GetFixedCols(Const StringGrid: TStringGrid; Var Cell: Variant);
    Procedure GetFixedRows(Const StringGrid: TStringGrid; Var Cell: Variant);
    Procedure GetStringGridBody(Const StringGrid: TStringGrid; Var Cell: Variant);

  Protected
    Procedure SetCellFont(NewFont: TFont);
    Procedure SetTitleFont(NewFont: TFont);
    Procedure SetVisible(DoShow: Boolean);
    Function GetCell(ARow, ACol: Integer): String;
    Procedure SetCell(ACol, ARow: Integer; Const Value: String);

    Function GetDateCell(ACol, ARow: Integer): TDateTime;
    Procedure SetDateCell(ACol, ARow: Integer; Const Value: TDateTime);

    //*********************************************自己添加************************************//
    Procedure SetCaption(ACaption: String); //设置打开文件后,Excel主程序的窗体标题
    Function GetCapiton: String; //返回打开文件后,Excel主程序的窗体标题

  Public
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
    Procedure CreateExcelInstance;
    Property Cell[ACol, ARow: Integer]: String Read GetCell Write SetCell;
    Property DateCell[ACol, ARow: Integer]: TDateTime Read GetDateCell Write SetDateCell;
    Function IsCreated: Boolean;
    Procedure TableToExcel(Const Table: TTable);
    Procedure QueryToExcel(Const Query: TQuery);
    Procedure StringGridToExcel(Const StringGrid: TStringGrid);
    Procedure SaveToExcel(Const FileName: String);

    //*********************************来自U_Report*****************************//
    Function GetRepRange(x, y: integer): String; //将(x,y)坐标形式改为Excel区域(A1:B1)形式
    Procedure CellMerge(x1, y1, x2, y2: integer); //合并指定单元格
    Procedure SetRepLine(x1, x2, y1, y2: Integer); //加边框线
    Procedure CellWrite(RepData: String; x, y: Integer); //单元格写数据
    Procedure CellFormat(x1, y1, x2, y2: integer); //指定单元格格式
    Procedure CellGS(x1, y1, x2, y2, f: integer); //灵活单元格格式

    Procedure CreatRepSheet(SheetName: String; PageSize, PageLay: Integer); //给当前工作表重命名、进行页面设置
    Procedure SetAddMess(H_Mess1, H_Mess2, H_Mess3, F_Mess1, F_Mess2, F_Mess3: String); //设置附加信息
    Procedure SetRepBody(x, ch: Integer; cw: Double; cf: String); //设置整体各列数据格式
    Procedure CreatTitle(TitleName: String; y: Integer); //设置标题
    Procedure CreatSubHead(SubTitle: Array Of String); //设置常规子表头
    Procedure SubHeadFormat(y, r: Integer); //设置子表头格式
    Procedure DTSubHeadGS(x, y, r: Integer); //设置动态子表头格式
    Procedure WriteData(RepData: String; x, y: Integer; flag: Integer = 0); //写入数据
    Procedure RepPageBreak(x, y, r: Integer); //分页、复制表头
    Procedure RepSaveAs(FileName: String); //保存为*.xls文
    Procedure RepPrivew; //预览

    //*********************************************自己添加************************************//
    Function FileCheck: FileCheckResult; //检查文件
    Function GetRowCount: Integer;
  Published
    Property TitleFont: TFont Read FTitleFont Write SetTitleFont;
    Property CellFont: TFont Read FCellFont Write SetCellFont;
    Property Visible: Boolean Read FVisible Write SetVisible;
    Property IgnoreFont: Boolean Read FIgnoreFont Write FIgnoreFont;
    Property FileName: TFileName Read FFileName Write FFileName;
    //*********************************来自U_Report*****************************//
    Property RCPrePage: Integer Read FRCPrePage Write FRCPrePage;
    Property MaxAC: Integer Read FMax Write FMax;


    //*********************************************自己添加************************************//
    Property CreateFromFile: Boolean Read FCreateFromFile Write FCreateFromFile;
    Property Caption: String Read GetCapiton Write SetCaption;
  End;

Procedure Register;

Implementation

Constructor TOLEExcel.Create(AOwner: TComponent);
Begin
  Inherited Create(AOwner);
  FIgnoreFont := True;
  FCellFont := TFont.Create;
  FTitleFont := TFont.Create;
  FExcelCreated := False;
  FVisible := False; //暂时不显示Excel窗体
  FCreateFromFile := False; //默认不是打开已有xls文件
  FFontChanged := False;
  FFileName := ''; //默认文件名为空
End;

Procedure TOLEExcel.CreateExcelInstance;
Var
  myFileCheckResult: FileCheckResult;
Begin
  If Not FCreateFromFile Then //启动Excel,打开一个空Excel表格
  Begin
    Try
      FExcel := CreateOLEObject('Excel.Application');
      If FExcel.WorkBooks.Count = 0 Then
        FWorkBook := FExcel.WorkBooks.Add
      Else
        FWorkBook := FExcel.WorkBooks[1];
        //FWorkSheet := FWorkBook.WorkSheets.Add;
      If FExcel.Sheets.Count = 0 Then FWorkSheet := FWorkBook.WorkSheets.Add //如果没有工作表,则创建一个
      Else //FWorkSheet := FExcel.ActiveSheet;//否则使用当前工作表
        FWorkSheet := FExcel.worksheets[1]; //否则使用当前工作簿第一个工作表
      FWorkSheet.Activate;
      //FWorkSheet := FExcel.WorkBooks[1].Sheets[1];
      FExcelCreated := True;
    Except
      MessageDlg('打开Exce失败,请确定您的机器里已安装MicrosoftExcel后,再使用本功能！', mtError, [mbOk], 0); ;
      FExcelCreated := False;
    End;
  End
  Else //根据FFileName指定的文件名,打开文件
  Begin
    myFileCheckResult := FileCheck;
    Case myFileCheckResult Of
      fcrNotExistend:
        Begin
          ShowMessage('指定的文件不存在,无法打开,请重新选择文件!');
        End;
      fcrNotXSLFile:
        Begin
          ShowMessage('指定的文件不是合法的Excel格式文件,请重新选择文件!');
        End;
      fcrValidXSL:
        Begin
          Try
            FExcel := CreateOLEObject('Excel.Application');
            FWorkBook := FExcel.WorkBooks.Open(FFileName);

            If FExcel.Sheets.Count = 0 Then FWorkSheet := FWorkBook.WorkSheets.Add //如果没有工作表,则创建一个
            Else //FWorkSheet := FExcel.ActiveSheet;//否则使用当前工作表
              FWorkSheet := FExcel.worksheets[1]; //否则使用当前工作簿第一个工作表
          //FWorkSheet := FExcel.WorkBooks[1].Sheets[1];
            FWorkSheet.Activate;
            FExcelCreated := True;
          Except
            MessageDlg('打开文件失败,可能是您的电脑没有安装Excel软件,请先安装Excel软件！', mtError, [mbOk], 0); ;
            FExcelCreated := False;
          End;
        End;
    End;
  End;
End;

Destructor TOLEExcel.Destroy;
Begin
  FCellFont.Free;
  FTitleFont.Free;
  Try
    FExcel.Quit;
  Finally
    FExcel := Unassigned;
  End;
  Inherited Destroy;
End;

Procedure TOLEExcel.SetExcelCellFont(Var Cell: Variant);
Begin
  If FIgnoreFont Then exit;
  With FCellFont Do
  Begin
    Cell.Font.Name := Name;
    Cell.Font.Size := Size;
    Cell.Font.Color := Color;
    Cell.Font.Bold := fsBold In Style;
    Cell.Font.Italic := fsItalic In Style;
    Cell.Font.UnderLine := fsUnderline In Style;
    Cell.Font.Strikethrough := fsStrikeout In Style;
  End;
End;

Procedure TOLEExcel.SetExcelTitleFont(Var Cell: Variant);
Begin
  If FIgnoreFont Then exit;
  With FTitleFont Do
  Begin
    Cell.Font.Name := Name;
    Cell.Font.Size := Size;
    Cell.Font.Color := Color;
    Cell.Font.Bold := fsBold In Style;
    Cell.Font.Italic := fsItalic In Style;
    Cell.Font.UnderLine := fsUnderline In Style;
    Cell.Font.Strikethrough := fsStrikeout In Style;
  End;
End;


Procedure TOLEExcel.SetVisible(DoShow: Boolean);
Begin
  If Not FExcelCreated Then exit;
  If DoShow Then
    FExcel.Visible := True
  Else
    FExcel.Visible := False;
End;

Function TOLEExcel.GetCell(ARow, ACol: Integer): String;
Begin
  If Not FExcelCreated Then exit;
  result := FWorkSheet.Cells[ARow, ACol];
End;

Procedure TOLEExcel.SetCell(ACol, ARow: Integer; Const Value: String);
Var
  Cell: Variant;
Begin
  If Not FExcelCreated Then exit;
  Cell := FWorkSheet.Cells[ARow, ACol];
  SetExcelCellFont(Cell);
  Cell.Value := Value;
End;


Function TOLEExcel.GetDateCell(ACol, ARow: Integer): TDateTime;
Begin
  If Not FExcelCreated Then
  Begin
    result := 0;
    exit;
  End;
  result := StrToDateTime(FWorkSheet.Cells[ARow, ACol]);
End;

Procedure TOLEExcel.SetDateCell(ACol, ARow: Integer; Const Value: TDateTime);
Var
  Cell: Variant;
Begin
  If Not FExcelCreated Then exit;
  Cell := FWorkSheet.Cells[ARow, ACol];
  SetExcelCellFont(Cell);
  Cell.Value := '''' + DateTimeToStr(Value);
End;

Function TOLEExcel.IsCreated: Boolean;
Begin
  result := FExcelCreated;
End;

Procedure TOLEExcel.SetTitleFont(NewFont: TFont);
Begin
  If NewFont <> FTitleFont Then
    FTitleFont.Assign(NewFont);
End;

Procedure TOLEExcel.SetCellFont(NewFont: TFont);
Begin
  If NewFont <> FCellFont Then
    FCellFont.Assign(NewFont);
End;

Procedure TOLEExcel.GetTableColumnName(Const Table: TTable; Var Cell: Variant);
Var
  Col: integer;
Begin
  For Col := 0 To Table.FieldCount - 1 Do
  Begin
    Cell := FWorkSheet.Cells[1, Col + 1];
    SetExcelTitleFont(Cell);
    Cell.Value := Table.Fields[Col].FieldName;
  End;
End;

Procedure TOLEExcel.TableToExcel(Const Table: TTable);
Var
  Col, Row: LongInt;
  Cell: Variant;
Begin
  If Not FExcelCreated Then exit;
  If Table.Active = False Then exit;

  GetTableColumnName(Table, Cell);
  Row := 2;
  With Table Do
  Begin
    first;
    While Not EOF Do
    Begin
      For Col := 0 To FieldCount - 1 Do
      Begin
        Cell := FWorkSheet.Cells[Row, Col + 1];
        SetExcelCellFont(Cell);
        Cell.Value := Fields[Col].AsString;
      End;
      next;
      Inc(Row);
    End;
  End;
End;


Procedure TOLEExcel.GetQueryColumnName(Const Query: TQuery; Var Cell: Variant);
Var
  Col: integer;
Begin
  For Col := 0 To Query.FieldCount - 1 Do
  Begin
    Cell := FWorkSheet.Cells[1, Col + 1];
    SetExcelTitleFont(Cell);
    Cell.Value := Query.Fields[Col].FieldName;
  End;
End;


Procedure TOLEExcel.QueryToExcel(Const Query: TQuery);
Var
  Col, Row: LongInt;
  Cell: Variant;
Begin
  If Not FExcelCreated Then exit;
  If Query.Active = False Then exit;

  GetQueryColumnName(Query, Cell);
  Row := 2;
  With Query Do
  Begin
    first;
    While Not EOF Do
    Begin
      For Col := 0 To FieldCount - 1 Do
      Begin
        Cell := FWorkSheet.Cells[Row, Col + 1];
        SetExcelCellFont(Cell);
        Cell.Value := Fields[Col].AsString;
      End;
      next;
      Inc(Row);
    End;
  End;
End;

Procedure TOLEExcel.GetFixedCols(Const StringGrid: TStringGrid; Var Cell: Variant);
Var
  Col, Row: LongInt;
Begin
  For Col := 0 To StringGrid.FixedCols - 1 Do
    For Row := 0 To StringGrid.RowCount - 1 Do
    Begin
      Cell := FWorkSheet.Cells[Row + 1, Col + 1];
      SetExcelTitleFont(Cell);
      Cell.Value := StringGrid.Cells[Col, Row];
    End;
End;

Procedure TOLEExcel.GetFixedRows(Const StringGrid: TStringGrid; Var Cell: Variant);
Var
  Col, Row: LongInt;
Begin
  For Row := 0 To StringGrid.FixedRows - 1 Do
    For Col := 0 To StringGrid.ColCount - 1 Do
    Begin
      Cell := FWorkSheet.Cells[Row + 1, Col + 1];
      SetExcelTitleFont(Cell);
      Cell.Value := StringGrid.Cells[Col, Row];
    End;
End;

Procedure TOLEExcel.GetStringGridBody(Const StringGrid: TStringGrid; Var Cell: Variant);
Var
  Col, Row, x, y: LongInt;
Begin
  Col := StringGrid.FixedCols;
  Row := StringGrid.FixedRows;
  For x := Row To StringGrid.RowCount - 1 Do
    For y := Col To StringGrid.ColCount - 1 Do
    Begin
      Cell := FWorkSheet.Cells[x + 1, y + 1];
      SetExcelCellFont(Cell);
      Cell.Value := StringGrid.Cells[y, x];
    End;
End;

Procedure TOLEExcel.StringGridToExcel(Const StringGrid: TStringGrid);
Var
  Cell: Variant;
Begin
  If Not FExcelCreated Then exit;
  GetFixedCols(StringGrid, Cell);
  GetFixedRows(StringGrid, Cell);
  GetStringGridBody(StringGrid, Cell);
End;

Procedure TOLEExcel.SaveToExcel(Const FileName: String);
Begin
  If Not FExcelCreated Then exit;
  FWorkSheet.SaveAs(FileName);
  //FExcel.Application.quit;
  //FExcel:=Unassigned;
End;

Procedure Register;
Begin
  RegisterComponents('OleExcel', [TOLEExcel]);
End;

Function TOLEExcel.GetRepRange(x, y: integer): String; {将(x,y)坐标形式改为Excel区域(A1:B1)形式}
Var
  fX, fY: String;
Begin
  If y <= 0 Then fX := 'A';
  If y <= 26 Then fX := chr(64 + y);
  If y > 26 Then fX := chr(64 + (y Div 26)) + chr(64 + (y Mod 26));

  fY := IntToStr(x);
  Result := fX + fY;
End;

Procedure TOLEExcel.CellMerge(x1, y1, x2, y2: integer); {合并指定单元格}
Var
  RepSpace: String;
Begin
  If Not FExcelCreated Then exit;
  RepSpace := GetRepRange(x1, y1) + ':' + GetRepRange(x2, y2);
  FExcel.Range[RepSpace].Select;
  FExcel.Selection.Merge;
End;

Procedure TOLEExcel.SetRepLine(x1, x2, y1, y2: Integer); {加边框线}
Var
  RepSpace: String;
Begin
  If Not FExcelCreated Then exit;
  RepSpace := GetRepRange(x1, y1) + ':' + GetRepRange(x2, y2);
  FExcel.ActiveSheet.Range[RepSpace].Borders.LineStyle := xlContinuous;
End;

Procedure TOLEExcel.CellWrite(RepData: String; x, y: Integer);
Begin
  If Not FExcelCreated Then exit;
  FExcel.cells(x, y) := RepData;
End;

Procedure TOLEExcel.CellFormat(x1, y1, x2, y2: integer); {指定单元格格式}
Var
  RepSpace: String;
Begin
  If Not FExcelCreated Then exit;
  RepSpace := GetRepRange(x1, y1) + ':' + GetRepRange(x2, y2);
  FExcel.Range[RepSpace].Select;
  FExcel.Selection.NumberFormat := 'G/通用格式';
  FExcel.Selection.Font.Bold := True;
  FExcel.Selection.HorizontalAlignment := 3; //水平方向对齐方式:居中
End;

Procedure TOLEExcel.CellGS(x1, y1, x2, y2, f: integer); {灵活单元格格式}
Var
  RepSpace: String;
Begin
  If Not FExcelCreated Then exit;
  RepSpace := GetRepRange(x1, y1) + ':' + GetRepRange(x2, y2);
  FExcel.Range[RepSpace].Select;
  FExcel.Selection.NumberFormat := 'G/通用格式';
  FExcel.Selection.HorizontalAlignment := f; //水平方向对齐方式:居中
End;

Procedure TOLEExcel.CreatRepSheet(SheetName: String; PageSize, PageLay: Integer);
{给当前工作表重命名、进行页面设置}
Begin
  If Not FExcelCreated Then exit;
  FExcel.ActiveSheet.Name := SheetName; //重命名当前工作表
  //设置页面
  If PageSize = 1 Then FExcel.ActiveSheet.PageSetup.PaperSize := xlPaperA3; //纸张大小:A3
  If PageSize = 2 Then FExcel.ActiveSheet.PageSetup.PaperSize := xlPaperA4; //纸张大小   :A4
  If PageSize = 3 Then FExcel.ActiveSheet.PageSetup.PaperSize := xlPaperB5; //纸张大小   :B5
  If PageLay = 1 Then FExcel.ActiveSheet.PageSetup.Orientation := xlportrait; //页面放置方向：纵向
  If PageLay = 2 Then FExcel.ActiveSheet.PageSetup.Orientation := xlLandscape; //页面放置方向：横向

  //设置页宽自动适应
  FExcel.ActiveSheet.PageSetup.Zoom := False;
  FExcel.ActiveSheet.PageSetup.FitToPagesWide := 1;
  FExcel.ActiveSheet.PageSetup.FitToPagesTall := False;

  //设置页眉、页脚(即：页标题、页号)
  FExcel.ActiveSheet.PageSetup.RightFooter := '打印时间:   ' + '&D   &T';
  FExcel.ActiveSheet.PageSetup.CenterFooter := '第&''&P&''页，共&''&N&''页';

  //设置页边距:
  FExcel.ActiveSheet.PageSetup.TopMargin := 1.5 / 0.035;
  FExcel.ActiveSheet.PageSetup.BottomMargin := 1.5 / 0.035;
  FExcel.ActiveSheet.PageSetup.LeftMargin := 1 / 0.035;
  FExcel.ActiveSheet.PageSetup.RightMargin := 1 / 0.035;
  FExcel.ActiveSheet.PageSetup.HeaderMargin := 0.5 / 0.035;
  FExcel.ActiveSheet.PageSetup.FooterMargin := 0.5 / 0.035;

  //设置页面对齐方式
  FExcel.ActiveSheet.PageSetup.CenterHorizontally := True; //页面水平居中
  //FExcel.ActiveSheet.PageSetup.CenterVertically := True;          //页面垂直居中

  //设置整体字体格式
  FExcel.Cells.Font.Name := '宋体'; //字体
  FExcel.Cells.Font.Size := 12; //字号
  FExcel.Cells.RowHeight := 16; //行高
  FExcel.Cells.VerticalAlignment := 2; //垂直方向对齐方式:居中
End;

Procedure TOLEExcel.SetAddMess(H_Mess1, H_Mess2, H_Mess3, F_Mess1, F_Mess2, F_Mess3: String);
//用户自定义页眉、页脚（即：页标题、页号）
Begin
  If Not FExcelCreated Then exit;
  FExcel.ActiveSheet.PageSetup.LeftHeader := H_Mess1;
  FExcel.ActiveSheet.PageSetup.CenterHeader := H_Mess2;
  FExcel.ActiveSheet.PageSetup.RightHeader := H_Mess3;
End;

Procedure TOLEExcel.SetRepBody(x, ch: Integer; cw: Double; cf: String); //设置整体各列数据格式
Begin
  If Not FExcelCreated Then exit;
  FExcel.ActiveSheet.Columns[x].ColumnWidth := cw; //列宽
  FExcel.ActiveSheet.Columns[x].NumberFormat := Cf; //单元格数据格式
  FExcel.ActiveSheet.Columns[x].HorizontalAlignment := ch; //水平方向对齐方式
End;

Procedure TOLEExcel.CreatTitle(TitleName: String; y: Integer); {设置标题}
Var
  RepSpace: String;
Begin
  If Not FExcelCreated Then exit;
  CellMerge(1, 1, 1, y);
  FExcel.cells(1, 1) := TitleName;
  RepSpace := 'A1' + ':' + GetRepRange(1, y);
  FExcel.Range[RepSpace].Select;
  FExcel.Selection.NumberFormat := 'G/通用格式';
  FExcel.Selection.Font.Size := 22;
  FExcel.Selection.Font.Name := '黑体';
  FExcel.Selection.Font.Bold := True;
  FExcel.Selection.HorizontalAlignment := 3; //水平方向对齐方式:居中
  FExcel.Rows[1].RowHeight := 28;
End;

Function TOLEExcel.FileCheck: FileCheckResult; //检查文件
Begin
  If Not (FileExists(FFileName)) Then
  Begin
    Result := fcrNotExistend;
    Exit;
  End
  Else
  Begin
    If UpperCase(ExtractFileExt(FFileName)) <> '.XLS' Then Result := fcrNotXSLFile
    Else Result := fcrValidXSL;
  End;

End;

Procedure TOLEExcel.SetCaption(ACaption: String);
Begin
  If Not FExcelCreated Then exit;
  FExcel.Caption := ACaption;
End;

Function TOLEExcel.GetCapiton: String;
Begin
  If Not FExcelCreated Then exit;
  Result := FExcel.Caption;
End;

Procedure TOLEExcel.CreatSubHead(SubTitle: Array Of String); {设置常规子表头}
Var
  i, j: Integer;
Begin
  If Not FExcelCreated Then exit;
  j := 0;
  For i := Low(SubTitle) To High(SubTitle) Do
  Begin
    Inc(j);
    FExcel.cells(2, j) := SubTitle[i];
  End;
End;

Procedure TOLEExcel.SubHeadFormat(y, r: Integer); {设置子表头格式}
Var
  RepSpace: String;
  n: Integer;
Begin
  If Not FExcelCreated Then exit;
  RepSpace := 'A2' + ':' + GetRepRange(1 + r, y);
  FExcel.Range[RepSpace].Select;
  FExcel.Selection.NumberFormat := 'G/通用格式';
  FExcel.Selection.HorizontalAlignment := 3; //表头水平对齐方式:居中
  FExcel.Selection.Font.Bold := True;
  For n := 1 To r Do
  Begin
    FExcel.Rows[1 + n].RowHeight := 18;
    SetRepLine(1 + n, y, 1 + n, y);
  End;
End;

Procedure TOLEExcel.DTSubHeadGS(x, y, r: Integer); {设置动态子表头格式}
Var
  RepSpace: String;
  n: Integer;
Begin
  If Not FExcelCreated Then exit;
  RepSpace := GetRepRange(x, 1) + ':' + GetRepRange(x + r - 1, y);
  FExcel.Range[RepSpace].Select;
  FExcel.Selection.NumberFormat := 'G/通用格式';
  FExcel.Selection.HorizontalAlignment := 3; //表头水平对齐方式:居中
  FExcel.Selection.Font.Bold := True;
  For n := 0 To r - 1 Do
  Begin
    FExcel.Rows[x + n].RowHeight := 18;
    SetRepLine(x + n, y, x + n, y);
  End;
End;

Procedure TOLEExcel.WriteData(RepData: String; x, y: Integer; flag: Integer = 0); {写数据}
Begin
  If Not FExcelCreated Then exit;
  If flag = 1 Then //flag = 1 表示写入日期型数据
    FExcel.cells(x, y) := StrToDate(RepData)
  Else
    FExcel.cells(x, y) := RepData;
End;

Procedure TOLEExcel.RepPageBreak(x, y, r: Integer); //分页、复制表头
Var
  RepSpace: String;
  n: Integer;
Begin
  If Not FExcelCreated Then exit;
  FExcel.ActiveSheet.Rows[x].PageBreak := 1;
  RepSpace := 'A1' + ':' + GetRepRange(r + 1, y);
  FExcel.ActiveSheet.Range[RepSpace].Copy;
  RepSpace := 'A' + IntToStr(x);
  FExcel.ActiveSheet.Range[RepSpace].PasteSpecial;
  FExcel.Rows[x].RowHeight := 28;
  For n := 2 To r Do
    FExcel.Rows[x + n].RowHeight := 18;
End;

Procedure TOLEExcel.RepSaveAs(FileName: String);
  {保存为*.xls文件}
Begin
  If Not FExcelCreated Then exit;
  Try
    FWorkBook.saveas(FileName);
  Except
    MessageDlg('不能访问文件，请关闭Microsoft Excel后再运行本程序！', mtError, [mbOk], 0);
  End;
End;

Procedure TOLEExcel.RepPrivew; {打印预览当前工作簿的当前工作表}
Begin
  If Not FExcelCreated Then exit;
  FExcel.ActiveSheet.PrintPreview;
End;

Function TOLEExcel.GetRowCount: Integer;
Begin
  If Not FExcelCreated Then Result := 0
  Else Result := FWorkSheet.UsedRange.Rows.Count;
End;

End.

一个很方便的Excel类