delphi 导入excel

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
  ExcelApp : Variant ;
  oldCursor: TCurSor;
begin
  oldCursor := Screen.Cursor;
 //保存鼠标指针状态
  Screen.Cursor := crHourGlass;
  try
    CoInitializeEx(nil, 0);
    ExcelApp := CreateOleObject('Excel.Application');
    ExcelApp.Visible := true;
    try
      ExcelApp.WorkBooks.open(afilename);
//打开源文件
      ExcelApp.WorkSheets[1].Activate;
      ExcelApp.visible := False; //隐藏excel窗体
      if Assigned(func) then //执行导入函数
        func(ExcelApp.ActiveSheet); //传递sheet给函数进行导入
    finally
      ExcelApp.WorkBooks.Close ;
      ExcelApp.Quit ;
      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.




unit frmBuyingItemsP;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs,EmbeddableFormU, dxSkinsCore, dxSkinOffice2010Black,  dxSkinOffice2010Blue, dxSkinOffice2010Silver, dxSkinsDefaultPainters,  dxSkinsdxBarPainter, dxBar, cxClasses, cxGraphics, cxControls, cxLookAndFeels,  cxLookAndFeelPainters, cxStyles, dxSkinscxPCPainter, cxCustomData, cxFilter,  cxData, cxDataStorage, cxEdit, DB, cxDBData, cxGridLevel, cxGridCustomView,  cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGrid, ExtCtrls,  RzPanel, StdCtrls,cxCheckBox, DBClient, ADODB, ComCtrls;type  TCheckBoxClickEvent=procedure(Sender: TObject) of object;type  TCheckBoxClick = class(TObject)  private    FOnCheckBoxClick:TCheckBoxClickEvent; //定义一个内部事件,private里的只能在类内部调用  public    property View_UpCheckBoxColumnPropertiesChange:TCheckBoxClickEvent read FOnCheckBoxClick write FOnCheckBoxClick; //定义一个外部的事件end;type  TfrmBuyingItems = class(TEmbeddableForm)    dxBarManager1: TdxBarManager;    dxBarManager1Bar1: TdxBar;    barsearch: TdxBarButton;    barexport: TdxBarButton;    barimport: TdxBarButton;    baradd: TdxBarButton;    barmodify: TdxBarButton;    barclose: TdxBarButton;    RzGroupBox1: TRzGroupBox;    cxitems: TcxGridDBTableView;    cxGrid1Level1: TcxGridLevel;    cxGrid1: TcxGrid;    barsave: TdxBarButton;    edtno: TLabeledEdit;    cxitemsColumn1: TcxGridDBColumn;    cxitemsColumn2: TcxGridDBColumn;    cxitemsColumn3: TcxGridDBColumn;    cxitemsColumn4: TcxGridDBColumn;    cxitemsColumn5: TcxGridDBColumn;    cxitemsColumn6: TcxGridDBColumn;    cxitemsColumn7: TcxGridDBColumn;    cxitemsColumn8: TcxGridDBColumn;    cxitemsColumn9: TcxGridDBColumn;    cxitemsColumn10: TcxGridDBColumn;    cxitemsColumn11: TcxGridDBColumn;    cxitemsColumn12: TcxGridDBColumn;    cxitemsColumn13: TcxGridDBColumn;    cxitemsColumn14: TcxGridDBColumn;    cxitemsColumn15: TcxGridDBColumn;    cxitemsColumn16: TcxGridDBColumn;    cxitemsColumn17: TcxGridDBColumn;    cxitemsColumn18: TcxGridDBColumn;    cxitemsColumn19: TcxGridDBColumn;    cxitemsColumn20: TcxGridDBColumn;    cxitemsColumn21: TcxGridDBColumn;    cxitemsColumn22: TcxGridDBColumn;    cxitemsColumn23: TcxGridDBColumn;    cxitemsColumn24: TcxGridDBColumn;    cxitemsColumn25: TcxGridDBColumn;    cxitemsColumn26: TcxGridDBColumn;    cxitemsColumn27: TcxGridDBColumn;    cxitemsColumn28: TcxGridDBColumn;    cxitemsColumn29: TcxGridDBColumn;    cxitemsColumn30: TcxGridDBColumn;    cxitemsColumn31: TcxGridDBColumn;    cxitemsColumn32: TcxGridDBColumn;    cxitemsColumn33: TcxGridDBColumn;    cxitemsColumn34: TcxGridDBColumn;    edtname: TLabeledEdit;    cxitemsColumn35: TcxGridDBColumn;    ClientDataSet1: TClientDataSet;    ADOQuery1: TADOQuery;    OpenDialog1: TOpenDialog;    barimport2: TdxBarButton;    RichEdit1: TRichEdit;    procedure barcloseClick(Sender: TObject);    procedure FormShow(Sender: TObject);    procedure barsearchClick(Sender: TObject);    procedure FormCreate(Sender: TObject);    procedure barimportClick(Sender: TObject);    procedure barsaveClick(Sender: TObject);  private    { Private declarations }  public    { Public declarations }    procedure View_UpCheckBoxColumnPropertiesChange(Sender: TObject);  end;var  frmBuyingItems: TfrmBuyingItems;implementation{$R *.dfm}uses dmbuyingitemsP,ExcelProUnit,dbmoduleP,Comobj,WordXP;var  sl: tStrings;  pubsql:string;procedure GetFromExcel(asheet: OleVariant);var  s, rs: string;  row: integer;  no,item_no,item_no_old,choice_name, name,name_old,buying_price,face_price,add_price,    native_trans_fee, price, national_tran_fee,service_charge_rate,    service_charge_fee, profit, chinese_kind_name, english_name,    weight, volume, american_price, real_american_price, hs_code,    upload_day, downshelf_day, leftdays, buying_name, buying_url,    status, korea_name, chinese_name,    clearance_sign_id_id, transport_way_id_id, tariff, add_express_fee: string;    adodata: TADOQuery;  id:string;  clearance_sign,transport_way:string;begin  row := 1;  s := trim(vartostr(aSheet.cells[row, 1]));  pubsql := '';  while s <> '' do  begin    if row > 490 then    begin    no := trim(vartostr(aSheet.cells[row, 1]));    item_no := trim(vartostr(aSheet.cells[row, 2]));    item_no := dmbuyingitems.getmaxBuyingItems_Id;    item_no_old := trim(vartostr(aSheet.cells[row, 2]));    choice_name := trim(vartostr(aSheet.cells[row, 3]));    name := trim(vartostr(aSheet.cells[row, 4]));    name := choice_name + ' ' + item_no;    name_old := trim(vartostr(aSheet.cells[row, 4]));    buying_price := trim(vartostr(aSheet.cells[row, 5]));    if (buying_price = '') or (buying_price = Null) then      buying_price := '0';    face_price := trim(vartostr(aSheet.cells[row, 6]));    if (face_price = '') or (face_price = Null) then      face_price := '0';    add_price := trim(vartostr(aSheet.cells[row, 7]));    if (add_price = '') or (add_price = Null) then      add_price := '0';    native_trans_fee := trim(vartostr(aSheet.cells[row, 8]));    if (native_trans_fee = '') or (native_trans_fee = Null) then      native_trans_fee := '0';    price := trim(vartostr(aSheet.cells[row, 9]));    if (price = '') or (price = Null) then      price := '0';    national_tran_fee := trim(vartostr(aSheet.cells[row, 10]));    if (national_tran_fee = '') or (national_tran_fee = Null) then      national_tran_fee := '0';    service_charge_rate := trim(vartostr(aSheet.cells[row, 11]));    if (service_charge_rate = '') or (service_charge_rate = Null) then      service_charge_rate := '0';    service_charge_fee := trim(vartostr(aSheet.cells[row, 12]));    if (service_charge_fee = '') or (service_charge_fee = Null) then      service_charge_fee := '0';    profit := trim(vartostr(aSheet.cells[row, 13]));    if (profit = '') or (profit = Null) then      profit := '0';    chinese_kind_name := trim(vartostr(aSheet.cells[row, 14]));    english_name := trim(vartostr(aSheet.cells[row, 15]));    weight := trim(vartostr(aSheet.cells[row, 16]));    if (weight = '') or (weight = Null) then      weight := '0';    volume := trim(vartostr(aSheet.cells[row, 17]));    if (volume = '') or (volume = Null) then      volume := '0';    american_price := trim(vartostr(aSheet.cells[row, 18]));    if (american_price = '') or (american_price = Null) then      american_price := '0';    real_american_price := trim(vartostr(aSheet.cells[row, 19]));    if (real_american_price = '') or (real_american_price = Null) then      real_american_price := '0';    hs_code := trim(vartostr(aSheet.cells[row, 20]));    upload_day := trim(vartostr(aSheet.cells[row, 21]));    downshelf_day := trim(vartostr(aSheet.cells[row, 22]));    leftdays := trim(vartostr(aSheet.cells[row, 23]));    if (leftdays = '') or (leftdays = Null) then      leftdays := '0';    buying_name := trim(vartostr(aSheet.cells[row, 24]));    buying_url := trim(vartostr(aSheet.cells[row, 25]));    status := trim(vartostr(aSheet.cells[row, 26]));    korea_name := trim(vartostr(aSheet.cells[row, 27]));    chinese_name := trim(vartostr(aSheet.cells[row, 28]));    transport_way := trim(vartostr(aSheet.cells[row, 29]));    clearance_sign := trim(vartostr(aSheet.cells[row,30]));    if (clearance_sign = '') or (clearance_sign = null) then    begin      Application.MessageBox('请输入通关符号','提示',MB_ICONWARNING);      Abort;    end;    if (transport_way = '') or (transport_way = null) then    begin      Application.MessageBox('请输入货运方式','提示',MB_ICONWARNING);      Abort;    end;    clearance_sign_id_id := dmbuyingitems.get_clearance_sign_id(clearance_sign);    transport_way_id_id := dmbuyingitems.get_transport_way_id(transport_way);    clearance_sign_id_id := '1';    transport_way_id_id := '1';    tariff := trim(vartostr(aSheet.cells[row, 31]));    if (tariff = '') or (tariff = Null) then      tariff := '0';    add_express_fee := trim(vartostr(aSheet.cells[row, 32]));    if (add_express_fee = '') or (add_express_fee = Null) then      add_express_fee := '0';    pubsql := pubsql + ' insert into erp_buyingitem(no,item_no,item_no_old,choice_name, name,name_old,buying_price,face_price,add_price,'      + ' native_trans_fee, price, national_tran_fee,service_charge_rate,'      + ' service_charge_fee, profit, chinese_kind_name, english_name,'      + ' weight, volume, american_price, real_american_price, hs_code,'      + ' upload_day, downshelf_day, leftdays, buying_name, buying_url, '      + ' status, korea_name, chinese_name,'      + ' clearance_sign_id_id, transport_way_id_id, tariff, add_express_fee)';    pubsql := pubsql + 'select ' + QuotedStr(no) + ',' + QuotedStr(item_no) + ',' + QuotedStr(item_no_old) + ',' + QuotedStr(choice_name)      + ',' + QuotedStr(name) + ',' + QuotedStr(name_old) + ',' + QuotedStr(buying_price) + ',' + QuotedStr(face_price) + ',' + QuotedStr(add_price)      + ',' + QuotedStr(native_trans_fee) + ',' + QuotedStr(price) + ',' + QuotedStr(national_tran_fee) + ',' + QuotedStr(service_charge_rate)      + ',' + QuotedStr(service_charge_fee) + ',' + QuotedStr(profit) + ',' + QuotedStr(chinese_kind_name) + ',' + QuotedStr(english_name)      + ',' + QuotedStr(weight) + ',' + QuotedStr(volume) + ',' + QuotedStr(american_price) + ',' + QuotedStr(real_american_price)      + ',' + QuotedStr(hs_code) + ',' + QuotedStr(upload_day) + ',' + QuotedStr( downshelf_day) + ',' + QuotedStr(leftdays)      + ',' + QuotedStr(buying_name) + ',' + QuotedStr(buying_url) + ',' + QuotedStr(status) + ',' + QuotedStr(korea_name)      + ',' + QuotedStr(chinese_name) + ',' + QuotedStr(clearance_sign_id_id) + ',' + QuotedStr(transport_way_id_id) + ','      + QuotedStr(tariff) + ',' + QuotedStr(add_express_fee);    end;    inc(row);    sl.Add(rs);    s := trim(vartostr(aSheet.cells[row, 3]));  end;end;procedure TfrmBuyingItems.barcloseClick(Sender: TObject);begin  close;end;procedure TfrmBuyingItems.barimportClick(Sender: TObject);begin  OpenDialog1.Title := '请选择正确的excel文件';  OpenDialog1.Filter := 'Excel(*.xls)|*.xls';  if OpenDialog1.Execute then  begin  //  RunExcelApplication(ExtractFilePath(application.ExeName) + 'success.xls', GetFromExcel);    RunExcelApplication(OpenDialog1.FileName, GetFromExcel);    RichEdit1.Text := pubsql;    try      dbmodule.SHSCon.BeginTrans;      dmbuyingitems.exesql(pubsql);      dbmodule.SHSCon.CommitTrans;      Application.MessageBox('导入成功!','提示',MB_OK);      barsearchClick(self);    Except      dbmodule.SHSCon.RollbackTrans;      Application.MessageBox('导入失败!','提示',MB_OK);    end;    //memo1.Lines.AddStrings(sl);  end;  {    RunExcelApplication(ExtractFilePath(application.ExeName) + 'success.xlsx', GetFromExcel);  memo1.Lines.AddStrings(sl);  }end;procedure TfrmBuyingItems.barsaveClick(Sender: TObject); var excelx,excely : string;   ExcelApp,WorkBook:oleVariant;   ExcelRowCount,i:integer;begin  OpenDialog1.Title := '请选择正确的excel文件';  OpenDialog1.Filter := 'Excel(*.xls)|*.xls';  if OpenDialog1.Execute then  begintryExcelApp := CreateOleObject('Excel.Application');WorkBook := CreateOleObject('Excel.Sheet');WorkBook := ExcelApp.WorkBooks.Open(opendialog1.FileName);//使用opendialog对话框指定//excel档路径ExcelApp.Visible := false;ExcelRowCount := WorkBook.WorkSheets[1].UsedRange.Rows.Count;for i := 1 to excelrowcount + 1 dobeginexcelx := excelapp.Cells[i,1].Value;excely := excelapp.Cells[i,2].Value;if ((excelapp.Cells[i,1].Value = '') and (ExcelApp.Cells[i,2].Value = '')) then//指定excel档的第 i 行 ,第 1,2(看情况而定)行如果为空就退出,这样的设定,最好是你的//档案力这两行//对应数据库中不能为空的数据exitelsewith adoquery1 dobeginclose;sql.clear;sql.add('insert into test(name,address) values(:name,:address)');Parameters.parambyname('name').value := excelx;//excel档的第一列插入到test表的 name栏位;Parameters.parambyname('address').value := excely;//excel档的第二列插入到test表的address 栏位;execsql;end;end;finallyWorkBook.Close;ExcelApp.Quit;ExcelApp := Unassigned;WorkBook := Unassigned;end;  end;end;procedure TfrmBuyingItems.barsearchClick(Sender: TObject);var  item_no,name:string;begin  dmbuyingitems.getBuyingItems(item_no,name);  cxitems.DataController.DataSource := dmbuyingitems.dsitems;end;procedure TfrmBuyingItems.FormCreate(Sender: TObject);begin  sl := TStringList.Create;end;procedure TfrmBuyingItems.FormShow(Sender: TObject);var  i:Integer;begin  for i := 0 to self.ComponentCount - 1 do  begin    if Self.Components[i] is TLabeledEdit then    begin      with Self.Components[i] as TLabeledEdit do      begin        BevelEdges := [beBottom];        BevelInner:=bvNone;        BevelKind :=bkSoft;        BevelOuter:=bvRaised;        BorderStyle:=bsNone;        ParentColor:=True;      end;    end;  end;  barsearchClick(self);  ClientDataSet1.FieldDefs.Clear;  for i:=0 to dmbuyingitems.adoItems.FieldCount-1 do  begin    with ClientDataSet1.FieldDefs.AddFieldDef do    begin      Name:= dmbuyingitems.adoItems.Fields[i].DisplayName;      if dmbuyingitems.adoItems.Fields.Fields[i].DataType=ftAutoInc then        DataType:=ftInteger      else if dmbuyingitems.adoItems.Fields.Fields[i].DataType=ftWideString then        DataType:=ftString      else        DataType :=dmbuyingitems.adoItems.Fields.Fields[i].DataType;//取原数据字段数据类型      Size:=dmbuyingitems.adoItems.Fields.Fields[i].Size;    end;  end;  ClientDataSet1.CreateDataSet;  dmbuyingitems.dsitems.DataSet := dmbuyingitems.adoItems;  cxitems.DataController.DataSource := dmbuyingitems.dsitems; // cxyzjl.ClearItems; // cxyzjl.CreateColumn;//建立一个没绑定的列  cxitems.Columns[0].Caption:='选择';//  cxitems.DataController.CreateAllItems;//建立所有绑定的列//  dw_checker1.Columns[0].DataBinding.FieldName := 'flag';  cxitems.Columns[0].Width:=45;    //下列5行语句是为了让没绑定列成为 CheckBox :  cxitems.DataController.KeyFieldNames:='id';  cxitems.DataController.MasterKeyFieldNames := 'id';  cxitems.DataController.DetailKeyFieldNames := 'id';  cxitems.DataController.DataModeController.SmartRefresh:=true;  cxitems.Columns[0].DataBinding.ValueType:='Boolean';  cxitems.Columns[0].PropertiesClass:= TcxCheckBoxProperties;  (cxitems.Columns[0].Properties as TcxCheckBoxProperties).NullStyle:=nssUnchecked; //由于CheckBox列是动态列,所以需要给其关联一个OnChange的事件:  (cxitems.Columns[0].Properties as TcxCheckBoxProperties).OnChange:=View_UpCheckBoxColumnPropertiesChange;//关联事件  cxitems.OptionsView.Indicator:=true;  cxitems.OptionsView.NoDataToDisplayInfoText := '';end;procedure TfrmBuyingItems.View_UpCheckBoxColumnPropertiesChange(  Sender: TObject);begin  ////////////////////////////////////////////////////  if cxitems.Focused = true then  if (Sender as TcxCheckBox).checked then  begin    cxitems.ViewData.Rows[cxitems.Controller.FocusedRowIndex].Values[0]:= true;  end  else  begin   cxitems.ViewData.Rows[cxitems.Controller.FocusedRowIndex].Values[0]:= false;  end;end;end.

相关文章

相关标签/搜索