excel.pas

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

unit Excel;

interface

uses
  Excel2000, ActiveX, Windows, OleCtrls, SysUtils, Dialogs, ComObj;

type
{$DEFINE EXCEL}
  TFontStyle_A = packed record
    Name: string[32];
    Size: Integer;
    Bold: Boolean;
    Italic: Boolean;
    Underline: Boolean;
    Color: Integer;
  end;

  TFontStyle_B = packed record
    Name: string[32];
    Size: Integer;
    Bold: Boolean;
    Italic: Boolean;
    Underline: Boolean;
    ColorIndex: Word;
  end;

  TExcel = class(TObject)
  private
{$IFDEF EXCEL}
    FExcel: TExcelApplication;
    FApp: _Application;
    FLCID: Integer;
    FErrorStr: string;
    FIsNeedCloseExcel: Boolean; //是否需要关闭Excel
{$ENDIF}
  public
{$IFDEF EXCEL}
    constructor Create;
    destructor Destroy; override;
{$ENDIF}
    procedure ConnectToExcel; virtual; stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    procedure DisconnectFromExcel; virtual; stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    procedure Quit; virtual; stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    procedure SetActiveWorkBook(WorkBookName: string); virtual; stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    function GetActiveWorkBook: string; virtual; stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    procedure SetActiveWorkSheet(WorkSheetName: string); virtual; stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    function GetActiveWorksheet: string; virtual; stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    function OpenWorkBook(const FileName: string): Boolean; virtual; stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    procedure CloseWorkBook(WorkBookName: string; SaveChanges: Boolean); virtual;
      stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    function SaveWorkBook(WorkBookName: string): Boolean; overload; virtual;
      stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    function SaveWorkBook: Boolean; overload; virtual; stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    procedure SetFont(StartPos: string; EndPos: string; FontStyle: TFontStyle_A);
      overload; virtual; stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    procedure SetFont(StartPos: string; EndPos: string; FontStyle: TFontStyle_B);
      overload; virtual; stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    procedure SetAlign(StartPos: string; EndPos: string; XAlign: Integer;
      YAlign: Integer); virtual; stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    procedure FillColor(StartPos: string; EndPos: string; Color: Integer;
      Pattern: Integer); overload; virtual; stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    procedure FillColor(StartPos: string; EndPos: string; ColorIndex: Word;
      Pattern: Integer); overload; virtual; stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    procedure SaveWorkBookToHtml(const FileName: string); virtual; stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    procedure SetValue(Pos: string; Value: OleVariant); virtual; stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}

    //jyw 20071115
    //更改tab标题
    procedure SetTabName(OldTabSheetName, NewTabSheetName: string); virtual;
      stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    //生成新的tab
    procedure NewTab(TabName: string); virtual; stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    //Copy区域到区域
    procedure SetColumnLength(StartPos: string; ColumnLenght: integer); virtual;
      stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    //获取一个点的值
    function GetValue(TabName: string; Pos: string): string; virtual; stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    //获取一个点的font
    function GetFont(TabName: string; Pos: string): TFontStyle_A; virtual;
      stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    //判断一个workbook是否打开
    function IsExistOpen(FileName: string): boolean; virtual; stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}

    //jyw 20071218
    //删除一个cells.怎样去面向对象????
    procedure DelRangeForValue(Value: OleVariant); virtual; stdcall;
{$IFNDEF EXCEL} abstract;
{$ENDIF}
    property Excel: TExcelApplication read FExcel;
    property LCID: Integer read FLCID;
    property ErrStr: string read FErrorStr;
  end;

implementation

{ TExcel }

procedure TExcel.CloseWorkBook(WorkBookName: string; SaveChanges: Boolean);
var
  WorkBook: _WorkBook;
  i: Integer;
begin
  for i := 1 to FExcel.Workbooks.Count do
  begin
    WorkBook := FExcel.Workbooks.Item[i];
    if WorkBook.Path[FLCID] + '\' + WorkBook.Name = WorkBookName then
    begin
      WorkBook.Close(SaveChanges, EmptyParam, EmptyParam, FLCID);
      break;
    end;
  end;
  //WorkBook := FApp.Workbooks.Item[OleVariant(WorkBookName)];
  //WorkBook.Close(SaveChanges, EmptyParam, EmptyParam, FLCID);
end;

procedure TExcel.ConnectToExcel;
begin
  FExcel.Connect;
end;

constructor TExcel.Create;
begin
  inherited Create;
  CoInitialize(nil);
  try
    GetActiveOleObject('Excel.Application');
    FIsNeedCloseExcel := False;
  except
    FIsNeedCloseExcel := True;
  end;

  FExcel := TExcelApplication.Create(nil);
  FApp := FExcel.Application;
  FLCID := GetSystemDefaultLCID;
end;

procedure TExcel.DelRangeForValue(Value: OleVariant);
var
  Rg,BegoreRg: ExcelRange;
  WorkSheet: _Worksheet;
begin
  WorkSheet := (FExcel.ActiveSheet as _Worksheet);
  //Find 寻找
  While True do
  begin
    Rg := WorkSheet.Cells.Find(Value, FExcel.ActiveCell, xlFormulas, xlPart,
      xlByRows
      , xlNext, False, False);
    if Assigned(Rg) then    //找到
    begin
      Rg.Delete(xlUp);    //删除
    end
    else
    begin
      Break;
    end;
  end;
  {
      Cells.Find(What:="15866893617", After:=ActiveCell, LookIn:=xlFormulas, _
          LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
          MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate
      Cells.FindNext(After:=ActiveCell).Activate
      Cells.FindNext(After:=ActiveCell).Activate
      Cells.FindNext(After:=ActiveCell).Activate
      Rows("971:971").Select
      Application.CutCopyMode = False
      Selection.Delete Shift:=xlUp
  }
end;

destructor TExcel.Destroy;
begin
  if FIsNeedCloseExcel then
    //关闭Excel
    Self.Quit;

  FExcel.Free;
  CoUnInitialize;
  inherited Destroy;
end;

procedure TExcel.DisconnectFromExcel;
begin
  FExcel.Disconnect;
end;

procedure TExcel.FillColor(StartPos, EndPos: string; Color, Pattern: Integer);
var
  Worksheet: _Worksheet;
begin
  Worksheet := FApp.ActiveSheet as _Worksheet;
  with WorkSheet.Range[StartPos, EndPos].Interior do
  begin
    Color := OleVariant(Color);
    Pattern := OleVariant(Pattern);
  end;
end;

procedure TExcel.FillColor(StartPos, EndPos: string; ColorIndex: Word; Pattern:
  Integer);
var
  Worksheet: _Worksheet;
begin
  Worksheet := FApp.ActiveSheet as _Worksheet;
  with WorkSheet.Range[StartPos, EndPos].Interior do
  begin
    ColorIndex := OleVariant(ColorIndex);
    Pattern := OleVariant(Pattern);
  end;
end;

function TExcel.GetActiveWorkBook: string;
var
  WorkBook: _WorkBook;
begin
  WorkBook := FApp.ActiveWorkbook;
  Result := WorkBook.Name;
end;

function TExcel.GetActiveWorksheet: string;
var
  WorkSheet: _WorkSheet;
begin
  WorkSheet := FApp.ActiveSheet as _WorkSheet;
  Result := WorkSheet.Name;
end;

function TExcel.OpenWorkBook(const FileName: string): Boolean;
begin
  Result := False;
  if not FileExists(FileName) then
    Exit;
  try
    FExcel.Workbooks.Open(OleVariant(FileName), EmptyParam, EmptyParam,
      EmptyParam, EmptyParam, EmptyParam, EmptyParam,
      EmptyParam, EmptyParam, EmptyParam, EmptyParam,
      EmptyParam, EmptyParam, FLCID);
    Result := True;
  except
  end;
end;

procedure TExcel.Quit;
begin
  FExcel.Quit;
end;

function TExcel.SaveWorkBook(WorkBookName: string): Boolean;
var
  Workbook: _WorkBook;
begin
  try
    Workbook := FExcel.ActiveWorkbook;
    WorkBook.SaveAs(WorkBookName, xlNormal, '', '', False, False,
      xlNoChange, xlLocalSessionChanges, False, EmptyParam, EmptyParam,
      LCID);
    Result := True;
  except
    on e: exception do
    begin
      Result := false;
      FErrorStr := e.Message;
    end;
  end;
end;

function TExcel.SaveWorkBook: Boolean;
var
  Workbook: _WorkBook;
begin
  WorkBook := FApp.ActiveWorkbook;
  try
    WorkBook.Save(FLCID);
    Result := True;
  except
    on e: exception do
    begin
      Result := false;
      FErrorStr := e.Message;
    end;
  end;
end;

procedure TExcel.SaveWorkBookToHtml(const FileName: string);
var
  Worksheet: _Worksheet;
begin
  Worksheet := FApp.ActiveSheet as _Worksheet;
  Worksheet.SaveAs(FileName, xlHtml, EmptyParam, EmptyParam, EmptyParam,
    EmptyParam, EmptyParam, EmptyParam, EmptyParam, FLCID);
end;

procedure TExcel.SetActiveWorkBook(WorkBookName: string);
var
  WorkBook: _WorkBook;
begin
  WorkBook := FApp.Workbooks.Item[OleVariant(WorkBookName)];
  WorkBook.Activate(FLCID);
end;

procedure TExcel.SetActiveWorkSheet(WorkSheetName: string);
var
  WorkSheet: _WorkSheet;
  WorkBook: _WorkBook;
begin
  WorkBook := FApp.ActiveWorkbook;
  WorkSheet := WorkBook.Worksheets.Item[OleVariant(WorkSheetName)] as
    _WorkSheet;
  WorkSheet.Activate(FLCID);
end;

procedure TExcel.SetAlign(StartPos, EndPos: string; XAlign,
  YAlign: Integer);
var
  WorkSheet: _WorkSheet;
begin
  WorkSheet := FApp.ActiveSheet as _WorkSheet;
  with WorkSheet.Range[StartPos, EndPos] do
  begin
    HorizontalAlignment := OleVariant(XAlign);
    VerticalAlignment := OleVariant(YAlign);
  end;
end;

procedure TExcel.SetFont(StartPos, EndPos: string; FontStyle: TFontStyle_A);
var
  WorkSheet: _WorkSheet;
begin
  WorkSheet := FApp.ActiveSheet as _WorkSheet;
  with WorkSheet.Range[StartPos, EndPos].Font do
  begin
    Name := OleVariant(FontStyle.Name);
    Size := OleVariant(FontStyle.Size);
    Italic := OleVariant(FontStyle.Italic);
    Bold := OleVariant(FontStyle.Bold);
    Underline := OleVariant(FontStyle.Underline);
    Color := OleVariant(FontStyle.Color);
  end;
end;

procedure TExcel.SetFont(StartPos, EndPos: string; FontStyle: TFontStyle_B);
var
  WorkSheet: _WorkSheet;
begin
  WorkSheet := FApp.ActiveSheet as _WorkSheet;
  with WorkSheet.Range[StartPos, EndPos].Font do
  begin
    Name := OleVariant(FontStyle.Name);
    Size := OleVariant(FontStyle.Size);
    Italic := OleVariant(FontStyle.Italic);
    Bold := OleVariant(FontStyle.Bold);
    Underline := OleVariant(FontStyle.Underline);
    Colorindex := OleVariant(FontStyle.ColorIndex);
  end;
end;

procedure TExcel.SetValue(Pos: string; Value: OleVariant);
var
  WorkSheet: _WorkSheet;
begin
  WorkSheet := FApp.ActiveSheet as _WorkSheet;
  WorkSheet.Range[Pos, Pos].Value := Value;
end;

procedure TExcel.SetTabName(OldTabSheetName, NewTabSheetName: string);
var
  WorkSheet: _Worksheet;
  WorkBook: _WorkBook;
begin
  WorkBook := FApp.ActiveWorkbook;
  WorkSheet := WorkBook.Worksheets.Item[OldTabSheetName] as _Worksheet;
  WorkSheet.Name := NewTabSheetName;
end;

procedure TExcel.NewTab(TabName: string);
var
  WorkSheet: _Worksheet;
  WorkBook: _WorkBook;
begin
  WorkBook := FApp.ActiveWorkbook;
  WorkSheet :=
    WorkBook.Worksheets.Application.ActiveWorkbook.Worksheets.add(EmptyParam,
    WorkBook.Worksheets.Item[WorkBook.Worksheets.Count], EmptyParam, EmptyParam, 0)
    as _Worksheet; //Add(0 ,1,1,xlWorksheet,icid) as _Worksheet;
  WorkSheet.Name := TabName;
end;

function TExcel.GetValue(TabName: string; Pos: string): string;
var
  WorkSheet: _Worksheet;
  WorkBook: _WorkBook;
begin
  WorkBook := FApp.ActiveWorkbook;
  WorkSheet := WorkBook.Worksheets.Item[TabName] as _Worksheet;
  Result := WorkSheet.Range[Pos, Pos].Value;
end;

procedure TExcel.SetColumnLength(StartPos: string; ColumnLenght: integer);
var
  WorkSheet: _Worksheet;
begin
  WorkSheet := FApp.ActiveSheet as _WorkSheet;
  WorkSheet.Range[StartPos, StartPos].ColumnWidth := ColumnLenght;
end;

function TExcel.GetFont(TabName: string; Pos: string): TFontStyle_A;
var
  WorkSheet: _Worksheet;
  WorkBook: _WorkBook;
begin
  WorkBook := FApp.ActiveWorkbook;
  WorkSheet := WorkBook.Worksheets.Item[TabName] as _Worksheet;
  Result.Name := WorkSheet.Range[pos, pos].Font.Name;
  Result.Size := WorkSheet.Range[pos, pos].Font.Size;
  Result.Italic := WorkSheet.Range[pos, pos].Font.Italic;
  Result.Bold := WorkSheet.Range[pos, pos].Font.Bold;
  Result.Underline := WorkSheet.Range[pos, pos].Font.Underline;
  Result.Color := WorkSheet.Range[pos, pos].Font.Color;
end;

function TExcel.IsExistOpen(FileName: string): boolean;
var
  i: integer;
  TempName: string;
begin
  Result := false;
  for i := 1 to FApp.Workbooks.Count do
  begin
    TempName := FApp.Workbooks.Item[i].Name;
    if TempName = ExtractFileName(FileName) then
    begin
      Result := true;
      break;
    end;
  end;
end;

end.