delphi 导入excel

delphi 导入excel

• 来源:网络
• 更新日期:2020-07-14

摘要：系统运维 unit ExcelProUnit; interface type TExcelFunction = procedure(asheet: OleVariant); //声明导入函数 {访问单元格：shee

系统运维

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;

interface

uses
  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
  begin
try

ExcelApp := 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 do

begin

excelx := 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(看情况而定)行如果为空就退出,这样的设定,最好是你的
//档案力这两行//对应数据库中不能为空的数据

exit

else

with adoquery1 do

begin

close;
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;

finally

WorkBook.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.