unit1.pas

用delphi操作Excel

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    ProgressBar1: TProgressBar;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function XlsComToRow(OpnDlg: TOpenDialog; ProgrssBar: TProgressBar):Boolean;stdcall;external 'DLL.dll' name 'XlsComToRow';

procedure TForm1.Button1Click(Sender: TObject);
const
  BeginRow = 9; BeginCol = 7;
var
  ExlApp: Variant;
  ExlFileName: string;
  iRow, iCol, iiRow, i: Integer;
begin
  OpenDialog1.Filter := 'Excel(*.xls) ? *.xls';
  if OpenDialog1.Execute then
    ExlFileName := OpenDialog1.FileName;

  try
    ExlApp := CreateOleObject('Excel.Application');
  except
    Application.MessageBox('EXCEL没有安装！', '提示', MB_OK);
    Exit;
  end;
  //开始转换数据
  try
    ExlApp.WorkBooks.Open(ExlFileName);
    ExlApp.WorkBooks[1].WorkSheets.Add;
    ExlApp.WorkBooks[1].WorkSheets[2].Name := 'YuanShi';
    ExlApp.WorkBooks[1].WorkSheets[1].Cells[1, 1].value := '货号';
    ExlApp.WorkBooks[1].WorkSheets[1].Cells[1, 2].value := '颜色编号';
    ExlApp.WorkBooks[1].WorkSheets[1].Cells[1, 3].value := '内长';
    ExlApp.WorkBooks[1].WorkSheets[1].Cells[1, 4].value := '尺码';
    ExlApp.WorkBooks[1].WorkSheets[1].Cells[1, 5].value := '数量';
    try
      iiRow := 2;
      ProgressBar1.Position := 0;
      for iRow := BeginRow to ExlApp.WorkSheets[2].UsedRange.Rows.Count - 1 do
      begin
        for iCol := BeginCol to ExlApp.WorkSheets[2].UsedRange.Columns.Count - 1 do
        begin
          if trim(ExlApp.WorkSheets[2].Cells[iRow, iCol].value) <> '' then
          begin
            ExlApp.WorkSheets[1].Cells[iiRow, 1].value := trim(ExlApp.WorkSheets[2].Cells[iRow, 3].value);  //货号
            ExlApp.WorkSheets[1].Cells[iiRow, 2].value := trim(ExlApp.WorkSheets[2].Cells[iRow, 4].value);  //颜色编号
            ExlApp.WorkSheets[1].Cells[iiRow, 3].value := trim(ExlApp.WorkSheets[2].Cells[iRow, 5].value);  //内长
            for i:=3 to 7 do
            begin
              if trim(ExlApp.WorkSheets[2].Cells[i, 6].value) = trim(ExlApp.WorkSheets[2].Cells[iRow, 6].value) then
                ExlApp.WorkSheets[1].Cells[iiRow, 4].value := trim(ExlApp.WorkSheets[2].Cells[i, iCol].value);  //尺码
            end;
            ExlApp.WorkSheets[1].Cells[iiRow, 5].value := trim(ExlApp.WorkSheets[2].Cells[iRow, iCol].value);  //数量
            inc(iiRow);
          end;
        end;
        ProgressBar1.Position := ProgressBar1.Position + 1;
      end;
      Application.MessageBox('数据转换成功！', '提示', MB_OK+mb_iconinformation);
    except
      Application.MessageBox('数据转换失败！', '提示', MB_OK+mb_iconinformation);
    end;

    ExlApp.WorkBooks[1].Save;
    ExlApp.WorkBooks[1].Close;
    ExlApp.Quit;
    ExlApp := Unassigned;
  except
    ShowMessage('不能正确操作Excel文件');
    ExlApp.WorkBooks.Close;
    ExlApp.Quit;
    ExlApp := Unassigned;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    XlsComToRow(OpenDialog1, ProgressBar1);
end;

end.