u_operateexcel.pas

Micorsoft Excel 操作单元

unit U_OperateExcel;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Db, DBTables,Variants;
  type
    TExcel=class
      private
          xlapp:variant;          //变体类型
      public
          procedure CreateExcel(Alter:Boolean); //创建Excel 应用程序
         //创建新的工作表   BBMC:应用名称    TemplateFile:模板文件名 SheetName:工作表名称
          procedure OpenModel(Filename:string;Style:boolean);   //打开模板
          procedure OpenExcelFile(FileName:string);
          procedure AddNewSheet(BBMC:string;TemplateFile:string;SheetName:string);
          procedure InsertARow(LRow,LCol,RRow,RCol:integer);  //在loc位置插入一行 LRow,LCol为当前选中位置
          procedure DeleteARow(LRow,LCol,RRow,RCol:integer);   //删除行
          procedure RowFontStyle(R,S:integer);
          procedure MergerCell(Row1,Col1,Row2,Col2:integer);    //合并单元格
          procedure recordnull(firstrow,endrow,endcolumn:integer;tbdw,zbr:string);
          procedure ColumnsWidth(Col1,Col2,CW:integer); //从col1 到col2 列宽度
          procedure RowHigh(H:Integer);  //行高度 H
          procedure AllCellsAlignment(V_Value,H_Value:Integer); //2,3上下居中
          procedure ColumnsAlignment(Col,V,H:integer);          //列对齐方式
          procedure RowsAlignment(Row,V,H:integer);             //行对齐方式
          //从cell[row1,col1] 到cell[row2,col2]单元格对齐格式  value 2,3
          procedure EveryCellsAlignment(Row1,Col1,Row2,Col2,V_Value,H_Value:integer);
          procedure BorderStyle(Row1,Col1,Row2,Col2:integer);  //单元格边框
          procedure CellValue(Row,Col:integer;StrValue:string);  //单元格cells[row,col]的值为strvalue
          procedure smallpagesetup;
          procedure handlerange;
          procedure ExcelVisible(Visible:Boolean);   //Excel 可见否
          procedure SheetPrintPreview;               //打印预览
          procedure SheetPrint;                      //打印
          procedure SheetPrintSome(Page1,Page2:integer);  //打印page1 到page2页
          procedure CloseExcel;                      //关闭Excel应用程序
          procedure largepagesetup;
          procedure SaveExcel(Path:string);          //保存 文件
          procedure SaveModel(Path:string);      //保存模板
          Function  NowOpenFile:string;          //返回当前打开文件名
          function  GetCellValue(Row,Col:integer):string;  //获取单元格值
          procedure CopyCell(Srow1,Scol1,Srow2,Scol2:integer);  //复制单元格
          procedure PasteCell(Erow,Ecol:integer);               //粘贴单元格
          Procedure FormulaCell(row1,col1,row2,col2,row,col:integer;tag:string); //设置单元格公式
          function  Borderno(row,col:integer):boolean;
          procedure FreeExcel;                     //释放Excel接口
          Procedure CellSetFocus(Row1,Col1,Row2,Col2:integer);   //单元格获得焦点
          Function  GetCellLeftStyle(Row1,Col1,Row2,Col2:integer):integer; //cell leftstyle: 7
          Function  GetCellTopStyle(Row1,Col1,Row2,Col2:integer):integer;  //cell topstyle: 8
          Function  GetCellRightStyle(Row1,Col1,Row2,Col2:integer):integer; //cell rightstyle: 10
          Function  GetCellBottomStyle(Row1,Col1,Row2,Col2:integer):integer;//cell bottonstyle:9;
          Procedure SetCellTopStyle(Row1,Col1,Row2,Col2,value:integer);    //设置单元格上边框
          Procedure SetCellBottomStyle(Row1,Col1,Row2,col2,value:integer); //设置单元格下边框
          Procedure SetCellLeftStyle(Row1,Col1,Row2,Col2,value:integer);   //设置单元格左边框
          Procedure SetCellRightStyle(Row1,Col1,Row2,Col2,value:integer);  //设置单元格右边框
          Procedure WinSize(Width,Height:integer); //设置EXCEL窗体高度、宽度
          procedure CellsFont(Row1,Col1,Row2,Col2:integer;B,It:Boolean;C,Size:Integer);  //设置单元格字体
                                                 //B:Bold True|False,C:ColorIndex,Size:FontSize,IT:ITalic True|False
          procedure ExcelWindowState(State:Integer);//设置Excel窗体最小化state=0、常规窗体state=1、 最大化state=2

          function InputDataToExcel(ServerName:string;DataBaseName:string;UserName:string;Pwd:string;QueryStr:string):boolean; //数据批导入
          Function InputQueryData(Qry:TQuery):boolean;
          procedure FreeInterface;
    end;

implementation
  uses comobj;

procedure TExcel.CreateExcel(Alter:Boolean);
begin
  try
    xlapp:=GetActiveOleobject('Excel.Application'); //与当前应用程序实例挂钩 防止打开多个应用程序
    xlapp.activeworkbook.visible:=true; //  使 EXCEL  工作薄可见，否则不能显示excelworksheet内容
  except
    xlapp:=createoleobject('Excel.Application');
    xlapp.WorkBooks.add;
  end;
  xlapp.application.caption:='EXCEL数据报表';
  xlapp.displayalerts:=Alter;
end;


procedure TExcel.ExcelWindowState(State:Integer);
const
  xlMinimized = -4140;    //最大
  xlMaximized = -4137;    //最小
  xlNormal = -4143;       //常规
begin
  case state of
    0:xlapp.windowstate:=xlminimized;
    1:xlapp.windowstate:=xlnormal;
    2:xlapp.windowstate:=xlmaximized;
    else
      xlapp.windowstate:=xlnormal;
  end;
end;

procedure TExcel.WinSize(Width,Height:integer);
begin
  Excelwindowstate(1);////常态窗体 对于最大化的 窗体不能设置窗口大小及位置
  xlapp.left:=1;       //Excel窗体位置
  xlapp.top:=1;
  xlapp.Width:=Width;    //Excel窗体大小
  xlapp.Height:=Height;
end;

procedure TExcel.CellsFont(Row1,Col1,Row2,Col2:integer;B,It:Boolean;C,Size:Integer);
begin
  xlapp.range[xlapp.Activesheet.cells[row1,col1],xlapp.Activesheet.cells[row2,col2]].font.colorindex:=C;
  xlapp.range[xlapp.Activesheet.cells[row1,col1],xlapp.Activesheet.cells[row2,col2]].font.Bold:=B;
  xlapp.range[xlapp.Activesheet.cells[row1,col1],xlapp.Activesheet.cells[row2,col2]].font.italic:=it;
  xlapp.range[xlapp.Activesheet.cells[row1,col1],xlapp.Activesheet.cells[row2,col2]].font.size:=size;
end;

procedure TExcel.CellSetFocus(Row1,Col1,Row2,Col2:integer);
begin
  xlapp.range[xlapp.Activesheet.cells[row1,col1],xlapp.Activesheet.cells[row2,col2]].select;
end;

procedure TExcel.FreeExcel;
begin
  xlapp.displayalerts:=true;
  xlapp:=Unassigned;    //释放接口
end;

procedure TExcel.FreeInterface;
begin
  if not VarIsEmpty(xlapp) then
    xlapp:=Unassigned;    //释放接口
end;

procedure TExcel.CopyCell(Srow1,Scol1,Srow2,Scol2:integer);
begin
  xlapp.range[xlapp.Activesheet.cells[Srow1,Scol1],xlapp.Activesheet.cells[Srow2,Scol2]].select;
  xlapp.selection.copy;
end;

procedure TExcel.PasteCell(Erow,Ecol:integer);
begin
  xlapp.range[xlapp.Activesheet.cells[Erow,Ecol],xlapp.Activesheet.cells[Erow,Ecol]].select;
  xlapp.activesheet.paste;
end;

procedure TExcel.SaveExcel(Path:string);
begin
  xlapp.ActiveWorkbook.SaveAs(Path);
end;

procedure TExcel.SaveModel(Path:string);
begin
  xlapp.ActiveWorkbook.SaveAs(Path,17); //xlTemplate --17保存模板 *.XLT 文件
end;

procedure TExcel.largepagesetup;
begin
  xlapp.activesheet.pagesetup.PrintArea :='';
  xlapp.Activesheet.pagesetup.centerHorizontally:=False;
  xlapp.Activesheet.pagesetup.centervertically := True;
  xlapp.Activesheet.pagesetup.LeftMargin:=0;
  //  xlapp.Activesheet.pagesetup.BottomMargin:=0;
  xlapp.Activesheet.pagesetup.Orientation:=2;
  xlapp.Activesheet.pagesetup.FitToPagesWide:=1;
  xlapp.Activesheet.pagesetup.FittoPagesTall:=1;
  xlapp.Activesheet.pagesetup.PaperSize :=$00000008;
end;

procedure TExcel.OpenModel(Filename:string;Style:boolean);
begin    //Style参数为 True 时，会打开指定模板进行编辑。参数为 False 时，可根据指定模板打开新的工作簿。默认值为 False
  Xlapp.workbooks.open(Filename,,,,,,,,,Style);
end;

procedure TExcel.OpenExcelFile(FileName:string);
begin
  Xlapp.workbooks.open(FileName);
end;

procedure TExcel.AddNewSheet(BBMC:string;TemplateFile:string;SheetName:string);
begin
  if TemplateFile='' then
    xlapp.workbooks.add
  else
    xlapp.workbooks.add(TemplateFile);
  xlapp.workbooks[1].worksheets[1].name:=SheetName;
  xlapp.activewindow.caption:=BBMC;
end;

procedure TExcel.InsertARow(LRow,LCol,RRow,RCol:integer);
begin
  xlapp.range[xlapp.Activesheet.cells[Lrow,LCol],xlapp.Activesheet.cells[Rrow,RCol]].select;
  xlapp.selection.Insert(2); //1:活动单元格右移  2:活动单元格下移
end;

procedure TExcel.DeleteARow(LRow,LCol,RRow,RCol:integer);
begin
  xlapp.range[xlapp.Activesheet.cells[Lrow,LCol],xlapp.Activesheet.cells[Rrow,RCol]].select;
  xlapp.selection.delete(2);   //1:右方的单元格左移  2:下方的单元格上移
end;

procedure TExcel.RowFontStyle(R,S:integer);
var
  row:variant;
begin
  row:=xlapp.Activesheet.rows;
  row.rows[R].font.size:=S;
end;

procedure TExcel.mergercell(Row1,Col1,Row2,Col2:integer);
begin
  xlapp.range[xlapp.Activesheet.cells[Row1,Col1],xlapp.Activesheet.cells[Row2,col2]].merge;
  xlapp.range[xlapp.Activesheet.cells[Row1,Col1],xlapp.Activesheet.cells[Row2,col2]].WrapText:=true;
end;

procedure TExcel.recordnull(firstrow,endrow,endcolumn:integer;tbdw,zbr:string);
var
   sheet:variant;
begin
  sheet:=xlapp.workbooks[1].worksheets[1];
  //sheet.range[sheet.cells[firstrow,1],sheet.cells[endrow,endcolumn]].borders.linestyle:=1;
  xlapp.Range[sheet.cells[EndRow, 1],sheet.cells[EndRow, 1]].Value:='    填报单位:' + Tbdw;
  xlapp.Range[sheet.cells[EndRow, 15],sheet.cells[EndRow, 15]].Value:= '制表人:' + Zbr;
  xlapp.Range[sheet.cells[EndRow, EndColumn],sheet.cells[EndRow, EndColumn]].Value := '制表日期: '+'20'+datetostr(date)+' '+timetostr(time);
end;

procedure  TExcel.columnswidth(Col1,Col2,CW:integer);
var
  columnrange:variant;
  i:integer;
begin
  columnrange:=xlapp.Activesheet.columns;
  for i:=Col1 to Col2 do
  columnrange.columns[i].columnwidth:=CW;
end;