delphi 合并多个excel

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleServer, ComObj, Clipbrd, Buttons, ShellAPI; //务必加入ComObj

type
  TForm1 = class(TForm)
    btn3: TButton;
    btn1: TBitBtn;
    procedure btn3Click(Sender: TObject);
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

//合并两个Excel文件到一个Excel文件
function MergerExcel(sFile1Path, sFile2Path: string; sModelFile: string;
  sTargetFile: string; out sErrMsg: string): Boolean; overload;

//合并多个Excel文件到一个Excel文件
function MergerExcel(sFileList: TStrings; sModelFile: string;
  sTargetFile: string; out sErrMsg: string): Boolean; overload;

var
  Form1: TForm1;

implementation

{$R *.dfm}


function MergerExcel(sFile1Path, sFile2Path: string; sModelFile: string; sTargetFile: string; out
  sErrMsg: string): Boolean;
var ExcelApp: Variant;
  ExcelWorkBook1: OleVariant;
  ExcelWorkBook2: OleVariant;
  ExcelWorkBook3: OleVariant;
  i: Integer;
begin
  Result:=False;
  try
    ExcelApp := CreateOleObject('Excel.Application');
    //ExcelApp.Visible := True;

    ExcelWorkBook1 := ExcelApp.WorkBooks.Open(sFile1Path);
    ExcelWorkBook2 := ExcelApp.WorkBooks.Open(sFile2Path);
    ExcelWorkBook3 := ExcelApp.WorkBooks.Open(sModelFile);

    //骤文件骤Sheet复制到模版文件中
    for i := 1 to ExcelWorkbook1.Sheets.Count do
    begin
      ExcelWorkBook1.Sheets[i].Copy(Before := ExcelWorkBook3.Sheets[i]);
    end;
    ExcelWorkBook1.Close;
    for i := 1 to ExcelWorkbook2.Sheets.Count do
    begin
      ExcelWorkBook2.Sheets[i].Copy(Before := ExcelWorkBook3.Sheets[i]);
    end;
    ExcelWorkBook2.Close;

    //删除可能已经存在的目标文件
    if FileExists(sTargetFile) then
      DeleteFile(sTargetFile);

    //将生成的Model文件另存为
    ExcelWorkBook3.SaveAs(sTargetFile);
    ExcelWorkBook3.Close;

    ExcelApp.Quit;
    Result:=True;
  except
    on E: Exception do
    begin
      sErrMsg := E.Message;
      Result:=False;
    end;
  end;
end;

//合并多个Excel文件到一个Excel文件
function MergerExcel(sFileList: TStrings; sModelFile: string;
  sTargetFile: string; out sErrMsg: string): Boolean;
var ExcelApp: Variant;
  ExcelWorkBookS: OleVariant;
  ExcelWorkBookD: OleVariant;
  i,iFileOrder: Integer;
begin
  Result:=False;
  try
    ExcelApp := CreateOleObject('Excel.Application');
    //ExcelApp.Visible := True;

    ExcelWorkBookD := ExcelApp.WorkBooks.Open(sModelFile);

    for iFileOrder :=0  to sFileList.Count-1 do
    begin
      ExcelWorkBookS := ExcelApp.WorkBooks.Open(sFileList.Strings[iFileOrder]);
      //骤文件骤Sheet复制到模版文件中
      for i := 1 to ExcelWorkbookS.Sheets.Count do
      begin
        ExcelWorkBookS.Sheets[i].Copy(Before := ExcelWorkBookD.Sheets[i]);
      end;
      ExcelWorkBookS.Close;
    end;

    //删除可能已经存在的目标文件
    if FileExists(sTargetFile) then
      DeleteFile(sTargetFile);

    //将生成的Model文件另存为
    ExcelWorkBookD.SaveAs(sTargetFile);
    ExcelWorkBookD.Close;

    ExcelApp.Quit;
    Result:=True;
  except
    on E: Exception do
    begin
      sErrMsg := E.Message;
      Result:=False;
    end;
  end;
end;

procedure TForm1.btn3Click(Sender: TObject);
var sXlsFileName1, sXlsFileName2, sXlsFileName3, sTargetFile, s: string;
h:THandle;
begin
  sXlsFileName1 := ExtractFilePath(Application.ExeName) + '1.xls';
  sXlsFileName2 := ExtractFilePath(Application.ExeName) + '2.xls';
  sXlsFileName3 := ExtractFilePath(Application.ExeName) + '3.xls';
  sTargetFile := ExtractFilePath(Application.ExeName) + '4.xls';

  MergerExcel(sXlsFileName1, sXlsFileName2, sXlsFileName3, sTargetFile, s);
  ShellExecute(Handle, 'open', pchar(sTargetFile), nil, nil, SW_SHOWNORMAL);
end;

procedure TForm1.btn1Click(Sender: TObject);
var sl:TStrings;
  sModel,sTargetFile, s:string;
begin
  sl:=TStringList.Create;
  sl.Add(ExtractFilePath(Application.ExeName) + '1.xls');
  sl.Add(ExtractFilePath(Application.ExeName) + '2.xls');
  sl.Add(ExtractFilePath(Application.ExeName) + '包装方案1.xls');
  sl.Add(ExtractFilePath(Application.ExeName) + '包装方案2.xls');
  sl.Add(ExtractFilePath(Application.ExeName) + '包装方案3.xls');

  sModel:= ExtractFilePath(Application.ExeName) + '3.xls';
  sTargetFile:= ExtractFilePath(Application.ExeName) + '4.xls';
  MergerExcel(sl,sModel, sTargetFile, s);
end;

end.
 

//注意：把sheet1复制到sheet2时，如果sheet1中某个单元格内容字符数超过225时会出现截断该单元格内容的现象，这是Excel自身问题，获取解决办法请参阅MSDN相关文档。