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.

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;

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;

finally

WorkBook.Close;

ExcelApp.Quit;

ExcelApp := Unassigned;

WorkBook := Unassigned;

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;

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;

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.

本文转自鹅倌51CTO博客，原文链接： http://blog.51cto.com/kaixinbuliao/1979813，如需转载请自行联系原作者