unidelphone.pas

使用Delphi操作Excel的例子。 功能是从一个excel文件中删除另外一个excel文件已经存在的内容。

unit UniDelPhone;

interface

uses Excel, SysUtils, Excel2000, Controls, Forms, Windows;

type
  //从一个excel全集中删除一个excel子集.
  TExcelDelSub = class
  private
    SubContentCount: Integer; //子集个数
    SubContent: array of string; //子集内容
    FErrorStr: string; //错误字符串
    FExcel: TExcel;
    procedure GetSubContent(SubExcel: string); //从Excel中获取子集内容
    procedure DelSubOneRange(SubRangeContent: string); //删除一个内容
    procedure DelSubRange(AllExcel: string); //删除子集
    procedure ManageAllExcelDelSub(AllExcel, DescExcel: string); //处理过程
    procedure CheckFileRight(AllExcel, SubExcel, DescExcel: string);
      //检查文件正确性 ,如果不存在,抛出异常.如果目标文件存在,则提问是否删除.
    procedure CheckFileOpen(AllExcel, SubExcel, DescExcel: string); overload;
      //检查输入文件是否打开
    procedure CheckFileOpen(ExcelFile: string); overload;
      //检查文件是否被打开,如果打开,询问是否关闭,
    procedure WriteLog(LogInfo: string);
  protected
    procedure SetMaxProcess(Max: Integer);
    procedure StartProcess;
    procedure StepProcess;
    procedure EndProcess;
  public
    constructor Create;
    destructor Destroy; override;
    function Run(AllExcel, SubExcel, DescExcel: string): boolean; //执行

    property ErrStr: string read FErrorStr;
    //    function TestSaveAs(SubExcel,DescExcel:string):Boolean;
  end;

implementation

uses Classes, UnitMain;

{ TExcelDelSub }

procedure TExcelDelSub.CheckFileOpen(AllExcel, SubExcel,
  DescExcel: string);
begin
  CheckFileOpen(AllExcel);
  CheckFileOpen(SubExcel);
  CheckFileOpen(DescExcel);
end;

procedure TExcelDelSub.CheckFileOpen(ExcelFile: string);
begin
  if FExcel.IsExistOpen(ExcelFile) then
    if Application.MessageBox('文件已经被Excel打开,要关闭吗?',
      pchar(Application.Title), MB_OKCANCEL + MB_ICONQUESTION) = mrOK then
    begin
      FExcel.CloseWorkBook(ExcelFile, False);
    end
    else
      raise Exception.Create(ExcelFile + '已经被Excel打开,请关闭');
end;

procedure TExcelDelSub.CheckFileRight(AllExcel, SubExcel,
  DescExcel: string);
begin
  if FileExists(AllExcel) then
    if FileExists(SubExcel) then
    begin
      if FileExists(DescExcel) then
      begin
        if Application.MessageBox('目标文件已经存在,要覆盖吗?',
          PChar(Application.Title), MB_OKCANCEL + MB_ICONQUESTION) = mrOk then
        begin
          if not DeleteFile(PChar(DescExcel)) then
            raise Exception.Create('目标文件删除失败!');
        end
        else
          raise Exception.Create('目标文件已经存在!');
      end;
    end
    else
      raise Exception.Create(SubExcel + ' 文件不存在')
  else
    raise Exception.Create(AllExcel + ' 文件不存在')
end;

constructor TExcelDelSub.Create;
begin
  inherited Create;
  FExcel := TExcel.Create;
end;

procedure TExcelDelSub.DelSubOneRange(SubRangeContent: string);
begin
  FExcel.DelRangeForValue(SubRangeContent);
end;

procedure TExcelDelSub.DelSubRange(AllExcel: string);
var
  i: integer;
begin
  for i := 0 to SubContentCount - 1 do
  begin
    StepProcess;
    DelSubOneRange(SubContent[i]);
  end;
end;

destructor TExcelDelSub.Destroy;
begin
  FExcel.Free;
  inherited;
end;

procedure TExcelDelSub.GetSubContent(SubExcel: string);
var
  ExcelApp: TExcelApplication;
  i, j: Integer;
  ArrayCount: integer;
  RowCount, ColumnCount: Integer;
  CellContent: string;
  WorkSheet: _Worksheet;
begin
  ArrayCount := 1000;
  SetLength(SubContent, ArrayCount);
  if FExcel.OpenWorkBook(SubExcel) then
  begin
    //FExcel.SetActiveWorkBook(SubExcel);
    ExcelApp := FExcel.Excel;
    SubContentCount := 0;
    WorkSheet := (ExcelApp.ActiveSheet as _Worksheet);
    RowCount := WorkSheet.UsedRange[
      FExcel.LCID].Rows.Count;
    ColumnCount := WorkSheet.UsedRange[
      FExcel.LCID].Columns.Count;

    for i := 1 to RowCount do
    begin
      for j := 1 to ColumnCount do
      begin
        CellContent := WorkSheet.Cells.Item[i, j];
        if CellContent <> '' then
        begin
          Inc(SubContentCount);
          SubContent[SubContentCount - 1] := CellContent;
          if SubContentCount = ArrayCount then
          begin
            ArrayCount := ArrayCount + 500;
            SetLength(SubContent, ArrayCount);
          end;
        end;
      end;
    end;
    FExcel.CloseWorkBook(SubExcel, False);
  end;
end;

procedure TExcelDelSub.ManageAllExcelDelSub(AllExcel, DescExcel: string);
begin
  WriteLog('打开全集!');
  if not FExcel.OpenWorkBook(AllExcel) then
    ;
  if not FExcel.SaveWorkBook(DescExcel) then
    raise Exception.Create('保存数据时失败' + FExcel.ErrStr);
  FExcel.CloseWorkBook(AllExcel, False);
  FExcel.OpenWorkBook(DescExcel);
  WriteLog('从全集中删除子集!');
  DelSubRange(DescExcel);
  WriteLog('保存子集!');
  if not FExcel.SaveWorkBook then
    raise Exception.Create('保存数据时失败' + FExcel.ErrStr);
  FExcel.CloseWorkBook(DescExcel, false);
end;

function TExcelDelSub.Run(AllExcel, SubExcel, DescExcel: string): boolean;
begin
  Result := False;
  try
    StartProcess;
    WriteLog('连接Excel!');
    FExcel.ConnectToExcel;
    WriteLog('检查文件是否打开!');
    CheckFileOpen(AllExcel, SubExcel, DescExcel);
    WriteLog('检查文件正确性!');
    CheckFileRight(AllExcel, SubExcel, DescExcel);
    WriteLog('获取子集信息!');
    GetSubContent(SubExcel);
    WriteLog('子集数目为:' + IntToStr(SubContentCount));
    SetMaxProcess(SubContentCount + 15);
    WriteLog('从全集中删除子集开始!');
    ManageAllExcelDelSub(AllExcel, DescExcel);
    WriteLog('从全集中删除子集结束!');
    Result := true;
  except
    on e: exception do
    begin
      FErrorStr := e.Message;
    end;
  end;
  WriteLog('断开连接Excel!');
  FExcel.DisconnectFromExcel;
end;

//function TExcelDelSub.TestSaveAs(SubExcel,DescExcel: string): Boolean;
//begin
//  FExcel.ConnectToExcel;
//  FExcel.OpenWorkBook(SubExcel);
//  FExcel.SaveWorkBook(DescExcel);
//  //  FExcel.CloseWorkBook();
//  FExcel.DisconnectFromExcel;
//end;

procedure TExcelDelSub.SetMaxProcess(Max: Integer);
begin
  FrmMain.pb1.Max := Max;
end;

procedure TExcelDelSub.StartProcess;
begin
  FrmMain.pb1.Position := 0;
end;

procedure TExcelDelSub.StepProcess;
begin
  FrmMain.pb1.StepBy(1);
  FrmMain.Update;
end;

procedure TExcelDelSub.WriteLog(LogInfo: string);
begin
  FrmMain.WriteLog(LogInfo);
  StepProcess;
end;

procedure TExcelDelSub.EndProcess;
begin
  FrmMain.pb1.StepBy(FrmMain.pb1.Max - FrmMain.pb1.Position);
end;

end.