Delphi从Excel导入

Delphi从Excel导入数据

要写一程序从Excel导入数据，从网上查到通用程序的写法，我只做了少量修改。

ExcelProUnit.pas

unit ExcelProUnit;

interface
type
  TExcelFunction = procedure(asheet: OleVariant); //声明导入函数

  {访问单元格：sheet.cells[row,col]

转为string：vartostr(sheet.cells[row,col])

转为datetime：vartodatetime(sheet.cells[row,col])

}
  //afilename为数据源文件名，func为执行导入的函数
procedure RunExcelApplication(afilename: string; func: TExcelFunction);

implementation
uses Controls, Forms, ComObj, windows, sysutils;

procedure RunExcelApplication(afilename: string;
  func: TExcelFunction);
var
  app: OleVariant;
  oldCursor: TCurSor;
begin
  oldCursor := Screen.Cursor;
 //保存鼠标指针状态
  Screen.Cursor := crHourGlass;
  try
    CoInitializeEx(nil, 0);
    app := CreateOleObject('Excel.Application');
    try
      app.DisplayAlerts := False;
      app.WorkBooks.open(afilename);
//打开源文件
      app.WorkSheets[1].Activate;
      app.visible := False; //隐藏excel窗体
      if Assigned(func) then //执行导入函数
        func(app.ActiveSheet); //传递sheet给函数进行导入
    finally
      app.WorkBooks.close;
      app.quit; //关闭推出excel
      Screen.Cursor := oldCursor;
    end;
  except on e: Exception do
    begin
      MessageBox(GetActiveWindow, pchar(e.message), '提示', MB_OK + MB_ICONINFORMATION);
      Screen.Cursor := OldCursor;
      Exit;
    end;
  end;
end;

end.

主要考虑的地方是传进去的函数的写法。以下写法没有进行过多的细化主要是完成功能。

ExcelMainUnit.pas

unit excelmainUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses ExcelProUnit;
var
  sl: tStrings;
{$R *.dfm}

procedure GetFromExcel(asheet: OleVariant);
var
  s, rs: string;
  row: integer;
begin
  row := 1;
  s := trim(vartostr(aSheet.cells[row, 1]));
  while s <> '' do
  begin
    rs := '';
    rs := rs + vartostr(aSheet.cells[row, 1]) + '  ';
    rs := rs + vartostr(aSheet.cells[row, 2]) + '  ' + vartostr(aSheet.cells[row, 3]);
    inc(row);
    sl.Add(rs);
    s := trim(vartostr(aSheet.cells[row, 1]));
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  sl := TStringList.Create;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  RunExcelApplication(ExtractFilePath(application.ExeName) + 'success.xlsx', GetFromExcel);
  memo1.Lines.AddStrings(sl);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  RunExcelApplication(ExtractFilePath(application.ExeName) + 'success.xls', GetFromExcel);
  memo1.Lines.AddStrings(sl);
end;

end.

其中Excel数据为：
[code]

姓名 成绩 备注
Danny 100 完胜
Way 99 差一分完胜
Jay 59 没及格，太难受了
Joan 77 中等

[/code]

读取数据为：
[code]
姓名 成绩 备注
Danny 100 完胜
Way 99 差一分完胜
Jay 59 没及格，太难受了
Joan 77 中等
[/code]

2011-5-27 23:10 danny