delphi 导入excel

朱雀 2022-02-05 00:25 340阅读 0赞

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.

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