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;
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.
本文名称：delphi导入excel
当前URL：https://www.cdcxhl.com/article30/choppo.html
成都网站建设公司_创新互联，为您提供品牌网站制作、动态网站、虚拟主机、域名注册、网站维护、建站公司
声明：本网站发布的内容（图片、视频和文字）以用户投稿、用户转载内容为主，如果涉及侵权请尽快告知，我们将会在第一时间删除。文章观点不代表本网站立场，如需处理请联系客服。电话：028-86922220；邮箱：631063699@qq.com。内容未经允许不得转载，或转载时需注明来源： 创新互联
- 网站优化中细节：注意h1、h2、h3、strong标签优化 2021-07-26
- 深圳做网站其他标签优化 2022-06-06
- 搜索引擎推广怎样巧妙地运用标签优化网站？ 2023-04-24
- 关于网站标签优化你了解多少 2021-09-02
- 新手seo不知道的优化秘诀：tag标签优化 2020-08-25
- 网站结构和标签优化怎么做 2021-08-16
- 网站的优化-网站代码标签优化有哪些技巧 2014-10-11
- 企业网站制作如何利用H1标签优化 2021-09-07
- 成都网站建设技术篇：网站tag标签优化思路分析原文链接 2022-11-06
- 网站标签优化之网页标签优化技巧 2014-03-25
- seo培训：网站代码和标签优化 2020-07-23
- 现网站建设分析网站Tag标签优化几点如下： 2022-06-04