我用lazarus写的查找Excel数据工具


lazarus与delphi几乎一样。

{===========================================================}

{ 类名称:GetExcelVal                                                      }

{ 功  能:取Excel单元格值                                                  }

{ 作  者:绿 杨 荫 里   2016-12-13                                         }

{===========================================================}

unit myClass;

{$mode objfpc}{$H+}

interface

uses

  Classes, SysUtils,Dialogs,comobj,strutils, Grids, ComCtrls;

type

  GetExcelVal=class

  private

    exlPath,exlFile,SheetName:string;

    FindVal,dColStr:string;

    startRow,FindCol:word;

    printGrid:TStringGrid;

    prgsObj:TProgressBar;

    procedure GetExlPathFile();

    procedure GetExlSheet();

    procedure GetColStr();

    procedure GetPrintGrid();

    procedure GetProgressObj();

    procedure GetFindParameters();

  public

    cellValList:Tstringlist;

    JIEGUORow:word;

    //cvArr:array of string;

    procedure SetExlPathFile(pPath:string;pFile:shortstring);

    procedure SetExlSheet(pSheetName:shortstring);

    procedure SetGetColStr(pColStr:shortstring);

    procedure SetPrintGrid(pPrintGrid:TstringGrid);

    procedure SetProgressObj(pProgressObj:Tprogressbar);

    procedure SetFindParameters(pFindVal:variant;pFindCol:word;pstartRow:word);

    procedure ExcelOpen();

    procedure CellValFind(IsWhole:Boolean);  //打开excel

    procedure ExcelClose();

    procedure AutoAdjustColWidth();

end;

implementation

var

  exlApp,tmpSheet,aExlfile,searchV:variant;

  tmppath,tmpfile,tmpcolstr,tmpV:string;

  r,headRow,rEnd,f,fEnd,searchCol,fCount,x,w,w2:word;

  ColList:Tstringlist;

  aShtObj:oleVariant;

  aGrid:TStringGrid;

  aPrgsObj:Tprogressbar;

{===========================================================}

{ 接收用户参数值:Excel路径、文件名、工作表、查找值、返回列 }

procedure GetExcelVal.SetExlPathFile(pPath:string;pFile:shortstring);

begin

  exlpath:=pPath;

  exlFile:=pFile;

end;

procedure GetExcelVal.SetExlSheet(pSheetName:shortstring);

begin

  SheetName:=pSheetName;

end;

procedure GetExcelVal.SetGetColStr(pColStr:shortstring);

begin

  dColStr:=pColstr;

end;

procedure GetExcelVal.SetPrintGrid(pPrintGrid:TstringGrid);

begin

  printGrid:=pPrintGrid;

end;

procedure GetExcelVal.SetProgressObj(pProgressObj:Tprogressbar);

begin

  prgsObj:=pProgressObj;

end;

procedure GetExcelVal.SetFindParameters(pFindVal:variant;pFindCol:word;pStartRow:word);

begin

  findVal:=pFindVal;

  findCol:=pFindCol;

  startRow:=pStartRow;

end;

{===========================================================}

{获取参数提供给本程序使用                                          }

procedure GetExcelVal.GetExlPathFile();

begin

  tmppath:=exlpath;

  tmpfile:=exlFile;

  aExlfile:=UTF8Decode(tmppath+tmpfile);

end;

procedure GetExcelVal.GetExlSheet();

begin

  tmpSheet:=utf8toansi(sheetname);

end;

procedure GetExcelVal.GetColStr();

begin

  tmpcolstr:=dColStr;

  ColList:=tstringlist.Create;

  ColList.Delimiter:=';';

  collist.DelimitedText:=tmpcolstr;

  fCount:=collist.Count;

end;

procedure GetExcelVal.GetPrintGrid();

begin

  aGrid:=printGrid;

end;

procedure GetExcelVal.GetProgressObj();

begin

  aPrgsObj:=prgsObj;

end;

procedure GetExcelVal.GetFindParameters();

begin

  searchv:=utf8toAnsi(findval);

  searchcol:=findcol;

  headRow:=startrow;

end;

{===========================================================}

{下面是查找程序,首先打开Excel,然后执行查找-----------------------}

procedure GetExcelVal.ExcelOpen();

begin

  GetExlPathFile;

  exlapp:=createoleobject('excel.application');

  exlapp.workbooks.open(aExlfile);

  exlapp.visible:=false;

  GetExlSheet;          //获取excel工作表名称

  GetColStr;

  GetPrintGrid;         //获取输出网格(栅格)名称

  with agrid  do

  begin

    Clear;;

    RowCount:=20001;

    ColCount:=fCount+3;

    rowheights[0]:=16;

    ColWidths[0]:=30;

    Refresh;

  end;

  GetProgressObj;

  x:=1;

end;

procedure GetExcelVal.CellValFind(IsWhole:Boolean);

var

  b:word;

begin

  GetFindParameters;

  ashtobj:=exlapp.activeworkbook.sheets[tmpSheet];

  rEnd:=ashtobj.usedrange.row+ashtobj.usedrange.rows.count-1;

  headRow:=startrow;

  aPrgsObj.max:=rend;

  aPrgsObj.min:=0;

  aPrgsObj.Position:=0;

  for f:=1  to  agrid.ColCount-1 do

  begin

    agrid.Cells[f,0]:=chr(f+64);

  end;

  { 下面按完全匹配模式搜索 }

  if IsWhole then

    for r:=headRow to rEnd do

      begin

        tmpv:=ashtobj.cells[r,searchcol].value;

        if tmpv=searchv then

          begin

            JIEGUORow:=r;

            agrid.Cells[0,x]:=inttostr(x);

            agrid.Cells[1,x]:=ansitoutf8(tmpv);

            for f:=0  to  fCount-1 do

              begin

                b:=strtoint(collist[f]);

                tmpv:=ashtobj.cells[r,b].value;

                agrid.Cells[f+2,x]:=tmpv;

              end;

            agrid.Cells[fCount+2,x]:='原表第 '+inttostr(JIEGUORow)+' 行';

            x:=x+1;

          end;

        aPrgsObj.position:=r;

      end;

  { 下面按是否包含该查找字符进行搜索 }

  if not IsWhole  then

    for r:=headRow to rEnd do

      begin

        tmpv:=ashtobj.cells[r,searchcol].value;

        if pos(searchv,tmpv)>0 then  { Pos函数参数是Ansi类型的String }

          begin

            JIEGUORow:=r;

            agrid.Cells[0,x]:=inttostr(x);

            agrid.Cells[1,x]:=ansitoutf8(tmpv);

            for f:=0  to  fCount-1 do

              begin

                b:=strtoint(collist[f]);

                tmpv:=ashtobj.cells[r,b].value;

                agrid.Cells[f+2,x]:=tmpv;

              end;

            agrid.Cells[fCount+2,x]:='原表第 '+inttostr(JIEGUORow)+' 行';

            x:=x+1;

          end;

        aPrgsObj.position:=r;

      end;

end;

procedure GetExcelVal.AutoAdjustColWidth();

begin

  with agrid do

    begin

      RowCount:=x;

      rend:=rowcount-1;

      fend:=colcount-1;

      w:=Canvas.TextWidth('A');

      for f:=1 to fend do

        begin

          w2:=70;

          for r:=1 to rend do

            begin

              tmpv:=cells[f,r];

              x:=length(tmpv)*w;

              if w2<x then

                w2:=x;

            end;

          colwidths[f]:=w2;

        end;

    end;

end;

procedure GetExcelVal.ExcelClose();

begin

  exlapp.activeworkbook.close(false);

  exlapp.quit;

  exlapp:=unassigned;

end;

{结束---------------------------------------------------}

end. 


最新回复 (0)
返回