unit40.pas

一个用DELPHI做的对Excel的操作 可以通过本程序对EXCEL进行导入 导出操作 附上源码

 unit Unit40;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,ComObj,
  Dialogs, StdCtrls, Excel2000, OleServer;

Const    ReNo=23;     //一页显示的记录数
Const    MAX=35;     //最大的数组个数

Var
  ExlApp:OleVariant;
  ExlBook:OleVariant;

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

  procedure RepCreat;                               //创建OLE对象(Excel Application与WorkBook)
  procedure CreatRepSheet(SheetName:String;PageSize,PageLay:Integer);   //新建工作簿、页面设置
   procedure CreatRepSheet1(SheetName:String;PageSize,PageLay:Integer);   //新建工作簿、页面设置
  procedure SetAddMess(H_Mess1,H_Mess2,H_Mess3,F_Mess1,F_Mess2,F_Mess3:String); //设置附加信息
 procedure SetRepBody(col,colhor:Integer;colwidth:Double;colformat:String);
 // procedure SetRepBody(x,ch:Integer;cw:Double;cf:String);               //设置整体各列数据格式
  procedure CreatTitle(TitleName:String;y:Integer);                                 //设置标题
   procedure CreatTitle1(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,flag:Integer);                           //写入数据
  procedure RepPageBreak(x,y,r:Integer);                                      //分页、复制表头
   procedure RepPageBreak1(x,y,r:Integer);                                      //分页、复制表头
  procedure RepSaveAs(FileName:String);                                      //保存为*.xls文件
  procedure RepPrivew(FileName:String);                                                 //预览
  procedure RepQuit;                                                               //退出Excel
  procedure RepDestroy;                                                      //非正常退出Excel
  procedure writedata1(x,y:Integer;zt:string;dx,sp,cz:integer;nr:string;jc:boolean);
  procedure  setrowheight(x,y:integer);
implementation

function GetRepRange(x,y:integer):string;
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 CellMerge(x1,y1,x2,y2:integer);
{合并指定单元格}
Var
  RepSpace:String;
begin
  RepSpace:=GetRepRange(x1,y1)+':'+GetRepRange(x2,y2);
  ExlApp.Range[RepSpace].Select;
  ExlApp.Selection.Merge;
end;{CellMerge}

procedure CellFormat(x1,y1,x2,y2:integer);
{指定单元格格式}
Var
  RepSpace:String;
begin
  RepSpace:=GetRepRange(x1,y1)+':'+GetRepRange(x2,y2);
  ExlApp.Range[RepSpace].Select;
  ExlApp.Selection.NumberFormat :='00000000';

  ExlApp.Selection.Font.Bold:=True;
  ExlApp.Selection.HorizontalAlignment:=3;      //水平方向对齐方式:居中
  
end;{CellFormat}

procedure CellGS(x1,y1,x2,y2,f:integer);
{灵活单元格格式}
Var
  RepSpace:String;
begin
  RepSpace:=GetRepRange(x1,y1)+':'+GetRepRange(x2,y2);
  ExlApp.Range[RepSpace].Select;
  ExlApp.Selection.NumberFormat :='G/通用格式';
  ExlApp.Selection.HorizontalAlignment:=f;      //水平方向对齐方式:居中
end;{CellGS}

procedure SetRepLine(x,y:Integer);
{加边框线}
Var
  RepSpace:String;
begin
  RepSpace:=GetRepRange(x,1)+':'+GetRepRange(x,y);
  ExlApp.ActiveSheet.Range[RepSpace].Borders.LineStyle:=xlContinuous;
end;{SetRepLine}

procedure CellWrite(RepData: String; x,y:Integer);
{单元格写数据}
begin
  ExlApp.cells(x,y):=RepData;
 // ExlApp.Columns.AutoFit;
 // EXLAPP.Columns.WrapText:=true;
 // exlapp.rows.autofit;


end;{CellWrite}

procedure RepCreat;
{创建Excel对象}
begin
  try
    ExlApp:=CreateOLEObject('Excel.Application');
    ExlBook:=CreateOLEObject('Excel.Sheet');
    ExlApp.Visible :=True;
    ExlApp.DisplayAlerts := False;
  except
    MessageDlg('您的机器里未安装Microsoft Excel！', mtError, [mbOk], 0);
    Exit;
  end;{try}
end;{RepCreat}
procedure CreatRepSheet(SheetName:String;PageSize,PageLay:Integer);
{新建Excel工作簿、进行页面设置}
begin
  {新建Excel工作簿}
  if ExlApp.WorkBooks.Count<1 then
  begin
    ExlBook:=ExlApp.Workbooks.Add;      //ExlBook:=ExlApp.WorkBooks[1].WorkSheets[1];
    ExlApp.ActiveSheet.Name:=SheetName;
  end;{if}

  {进行页面设置}

//设置页面
  if PageSize=1 then
    ExlApp.ActiveSheet.PageSetup.PaperSize:=xlPaperA3;      //纸张大小 :A3
  if PageSize=2 then
    ExlApp.ActiveSheet.PageSetup.PaperSize:=xlPaperA4;      //纸张大小 :A4
  if PageSize=3 then
    ExlApp.ActiveSheet.PageSetup.PaperSize:=xlPaperB5;      //纸张大小 :B5
  if PageLay=1 then
    ExlApp.ActiveSheet.PageSetup.Orientation:=xlportrait;   //页面放置方向：纵向
  if PageLay=2 then
    ExlApp.ActiveSheet.PageSetup.Orientation:=xlLandscape;  //页面放置方向：横向

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

  //设置页眉、页脚(即：页标题、页号)
  ExlApp.ActiveSheet.PageSetup.RightFooter:='打印时间: '+'&D &T';
  ExlApp.ActiveSheet.PageSetup.CenterFooter:='第&''&P&''页，共&''&N&''页';
  ExlApp.ActiveSheet.PageSetup.PrintTitleRows :='$4:$4';
    //设置页边距:
  ExlApp.ActiveSheet.PageSetup.TopMargin:=1.5/0.035;
  ExlApp.ActiveSheet.PageSetup.BottomMargin:=1.5/0.035;
  ExlApp.ActiveSheet.PageSetup.LeftMargin:=1/0.035;
  ExlApp.ActiveSheet.PageSetup.RightMargin:=1/0.035;
  ExlApp.ActiveSheet.PageSetup.HeaderMargin:=0.5/0.035;
  ExlApp.ActiveSheet.PageSetup.FooterMargin:=0.5/0.035;

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

  //设置整体字体格式
  ExlApp.Cells.Font.Name:='宋体';                   //字体
  ExlApp.Cells.Font.Size:=12;                       //字号
  ExlApp.Cells.RowHeight:=16;                     //行高
  ExlApp.Cells.VerticalAlignment:=2;               //垂直方向对齐方式:居中
end;{CreatRepSheet}
procedure CreatRepSheet1(SheetName:String;PageSize,PageLay:Integer);
{新建Excel工作簿、进行页面设置}
begin
  {新建Excel工作簿}
  if ExlApp.WorkBooks.Count<1 then
  begin
    ExlBook:=ExlApp.Workbooks.Add;      //ExlBook:=ExlApp.WorkBooks[1].WorkSheets[1];
    ExlApp.ActiveSheet.Name:=SheetName;
  end;{if}

  {进行页面设置}

//设置页面
  if PageSize=1 then
    ExlApp.ActiveSheet.PageSetup.PaperSize:=xlPaperA3;      //纸张大小 :A3
  if PageSize=2 then
    ExlApp.ActiveSheet.PageSetup.PaperSize:=xlPaperA4;      //纸张大小 :A4
  if PageSize=3 then
    ExlApp.ActiveSheet.PageSetup.PaperSize:=xlPaperB5;      //纸张大小 :B5
  if PageLay=1 then
    ExlApp.ActiveSheet.PageSetup.Orientation:=xlportrait;   //页面放置方向：纵向
  if PageLay=2 then
    ExlApp.ActiveSheet.PageSetup.Orientation:=xlLandscape;  //页面放置方向：横向

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

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

  //设置页边距:
  ExlApp.ActiveSheet.PageSetup.TopMargin:=1.5/0.035;
  ExlApp.ActiveSheet.PageSetup.BottomMargin:=1.5/0.035;
  ExlApp.ActiveSheet.PageSetup.LeftMargin:=1/0.035;
  ExlApp.ActiveSheet.PageSetup.RightMargin:=1/0.035;
  ExlApp.ActiveSheet.PageSetup.HeaderMargin:=0.5/0.035;
  ExlApp.ActiveSheet.PageSetup.FooterMargin:=0.5/0.035;
  
  //设置页面对齐方式
  ExlApp.ActiveSheet.PageSetup.CenterHorizontally:=True;     //页面水平居中
//  ExlApp.ActiveSheet.PageSetup.CenterVertically :=True;      //页面垂直居中

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

procedure SetAddMess(H_Mess1,H_Mess2,H_Mess3,F_Mess1,F_Mess2,F_Mess3:String);
//用户自定义页眉、页脚（即：页标题、页号）
begin
  ExlApp.ActiveSheet.PageSetup.LeftHeader:=H_Mess1;
  ExlApp.ActiveSheet.PageSetup.CenterHeader:=H_Mess2;
  ExlApp.ActiveSheet.PageSetup.RightHeader:=H_Mess3;
end;{SetAddMess}

procedure SetRepBody(col,colhor:Integer;colwidth:Double;colformat:String);
//设置整体各列数据格式
begin
  ExlApp.ActiveSheet.Columns[col].ColumnWidth:=colwidth;           //列宽
  ExlApp.ActiveSheet.Columns[col].NumberFormat:=colformat;          //单元格数据格式
  ExlApp.ActiveSheet.Columns[col].HorizontalAlignment:=colhor;   //水平方向对齐方式
end;{SetRepBody}

procedure CreatTitle1(TitleName:String;y:Integer);
{设置标题}
Var
  RepSpace:String;
begin
  CellMerge(1,1,1,y);
  ExlApp.cells(1,1):=TitleName;
  RepSpace:='A1'+':'+GetRepRange(1,y);
  ExlApp.Range[RepSpace].Select;
  ExlApp.Selection.NumberFormat :='G/通用格式';
  ExlApp.Selection.Font.Size:=16;
  ExlApp.Selection.Font.Name:='黑体';
  ExlApp.Selection.Font.Bold:=True;
  ExlApp.Selection.HorizontalAlignment:=3;      //水平方向对齐方式:居中
  ExlApp.Rows[1].RowHeight:=28;
end;{RepHead}
procedure  setrowheight(x,y:integer);
begin
     ExlApp.Rows[x].RowHeight:=y;
     ExlApp.Rows[x].WrapText:=true;
end;

procedure CreatTitle(TitleName:String;y:Integer);
{设置标题}
Var
  RepSpace:String;
begin
  CellMerge(2,1,3,y);
  ExlApp.cells(2,1):=TitleName;
  RepSpace:='A2'+':'+GetRepRange(3,y);
  ExlApp.Range[RepSpace].Select;
  ExlApp.Selection.NumberFormat :='G/通用格式';
  ExlApp.Selection.Font.Size:=16;
  ExlApp.Selection.Font.Name:='黑体';
  ExlApp.Selection.Font.Bold:=True;
  ExlApp.Selection.HorizontalAlignment:=3;      //水平方向对齐方式:居中
  ExlApp.Rows[1].RowHeight:=40;
  EXLAPP.Selection.WrapText:=true ;
end;{RepHead}
procedure writedata1(x,y:Integer;zt:string;dx,sp,cz:integer;nr:string;jc:boolean);
{设置标题}
Var
  RepSpace:String;
begin

  ExlApp.cells(x,y):=nr;
  RepSpace:=GetRepRange(x,y)+':'+GetRepRange(x,y);
  ExlApp.Range[RepSpace].Select;
  ExlApp.Selection.NumberFormat :='G/通用格式';
  ExlApp.Selection.Font.Size:=dx;
  ExlApp.Selection.Font.Name:=zt;
  ExlApp.Selection.Font.Bold:=jc;
  ExlApp.Selection.HorizontalAlignment:=sp;
  ExlApp.Selection.VerticalAlignment:=cz;     //水平方向对齐方式:居中
  ExlApp.Rows[x].RowHeight:=dx+15;


end;{RepHead}


procedure CreatSubHead(SubTitle: Array of String);
{设置常规子表头}
Var
  i,j:Integer;
begin
  j:=0;
  for  i:=Low(SubTitle) to High(SubTitle) do
  begin
    Inc(j);
    ExlApp.cells(4,j):=SubTitle[i];
    setrepline(4,j);
  end;
end;{CreatRepHead}

procedure SubHeadFormat(y,r:Integer);
{设置子表头格式}
Var
  RepSpace:String;
  n:Integer;
begin
  RepSpace:='A2'+':'+GetRepRange(1+r,y);
  ExlApp.Range[RepSpace].Select;
  ExlApp.Selection.NumberFormat :='00000000';
  ExlApp.Selection.HorizontalAlignment:=3;        //表头水平对齐方式:居中
  ExlApp.Selection.Font.Bold:=True;
  for n:=1 to r do
  begin
    ExlApp.Rows[1+n].RowHeight:=18;
    SetRepLine(1+n,y);
  end;{for}
end;{SubHeadFormat}

procedure DTSubHeadGS(x,y,r:Integer);
{设置动态子表头格式}
Var
  RepSpace:String;
  n:Integer;
begin
  RepSpace:=GetRepRange(x,1)+':'+GetRepRange(x+r-1,y);
  ExlApp.Range[RepSpace].Select;
  ExlApp.Selection.NumberFormat :='G/通用格式';
  ExlApp.Selection.HorizontalAlignment:=3;        //表头水平对齐方式:居中
  ExlApp.Selection.Font.Bold:=True;
  for n:=0 to r-1 do
  begin
    ExlApp.Rows[x+n].RowHeight:=18;
  //  SetRepLine(x+n,y);
  end;{for}
end;{DTSubHeadGS}

procedure WriteData(RepData: String; x,y,flag:Integer); //写入数据
{写数据}
begin
  if flag=1 then
    ExlApp.cells(x,y):=StrToDate(RepData)
  else
    ExlApp.cells(x,y):=RepData;
end;{WriteDate}

procedure RepPageBreak(x,y,r:Integer);   //X：分页处行数，Y：列数，R：子表头总共的行数
//分页、复制表头
Var
  RepSpace:String;
  n:Integer;
begin
  ExlApp.ActiveSheet.Rows[x].PageBreak := 1;
  RepSpace:='A1'+':'+GetRepRange(r+1,y);
  ExlApp.ActiveSheet.Range[RepSpace].Copy;
  RepSpace:='A'+IntToStr(x);
  ExlApp.ActiveSheet.Range[RepSpace].PasteSpecial;
  ExlApp.Rows[x].RowHeight:=28;
  for n:=2 to r do
    ExlApp.Rows[x+n].RowHeight:=18;
end;{RepPageBreak}
procedure RepPageBreak1(x,y,r:Integer);   //X：分页处行数，Y：列数，R：子表头总共的行数
//分页、复制表头
Var
  RepSpace:String;
  n:Integer;
begin
  ExlApp.ActiveSheet.Rows[x].PageBreak := 1;
  
end;{RepPageBreak}

procedure RepSaveAs(FileName:String);
{保存为*.xls文件}
begin
  try
    ExlBook.saveas(FileName);
  except
    MessageDlg('不能访问文件，请关闭Microsoft Excel后再运行本程序！', mtError, [mbOk], 0);
  end;
end;{RepSaveAs}

procedure RepPrivew(FileName:String);
{预览}
begin
  RepCreat;
  ExlApp.Visible :=True;
  try
    ExlApp.workBooks.Open(FileName);
    ExlApp.Workbooks[1].WorkSheets[1].PrintPreview;
  finally
    ExlApp.Quit;
    ExlApp:=Unassigned;
    //ExlApp:='';
  end;{try}
end;{RepPrivew}

procedure RepQuit;
{退出Excel}
begin
 ExlBook.Close;
 ExlApp.Quit;       //退出Excel Application
 ExlApp:=Unassigned;  //释放VARIANT变量
end;{RepQuit}

procedure RepDestroy;
{非正常退出Excel}
begin
  if Not VarIsEmpty(ExlApp) then
    RepQuit;
end;{RepDestroy}

end.