Shulou(Shulou.com)06/02 Report--

Unit ExcelProUnit

Interface

Type

TExcelFunction = procedure (asheet: OleVariant); / / declare the import function

{access cell: sheet.cells [row,col]

Convert to string:vartostr (sheet.cells [row,col])

Convert to datetime:vartodatetime (sheet.cells [row,col])

}

/ / afilename is the file name of the data source, and func is the function that performs the import.

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

/ / Save mouse pointer state

Screen.Cursor: = crHourGlass

Try

CoInitializeEx (nil, 0)

ExcelApp: = CreateOleObject ('Excel.Application')

ExcelApp.Visible: = true

Try

ExcelApp.WorkBooks.open (afilename)

/ / Open source files

ExcelApp.WorkSheets [1] .Activate

ExcelApp.visible: = False; / / hide excel form

If Assigned (func) then / / execute the import function

Func (ExcelApp.ActiveSheet); / / pass sheet to the function for import

Finally

ExcelApp.WorkBooks.Close

ExcelApp.Quit

Screen.Cursor: = oldCursor

End

Except on e: Exception do

Begin

MessageBox (GetActiveWindow, pchar (e.message), 'prompt', 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; / / defines an internal event, which in private can only be called within the class

Public

Property View_UpCheckBoxColumnPropertiesChange:TCheckBoxClickEvent read FOnCheckBoxClick write FOnCheckBoxClick; / / define an external event

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 ('Please enter the customs clearance symbol', 'prompt', MB_ICONWARNING)

Abort

End

If (transport_way ='') or (transport_way = null) then

Begin

Application.MessageBox ('Please enter shipping method', 'prompt', 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: = 'Please select the correct excel file'

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 ('Import succeeded!' , 'prompt', MB_OK)

BarsearchClick (self)

Except

Dbmodule.SHSCon.RollbackTrans

Application.MessageBox ('Import failed!' , 'prompt', 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: = 'Please select the correct excel file'

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); / / specify using the opendialog dialog box

/ / excel file path

ExcelApp.Visible: = false

ExcelRowCount: = WorkBook.WorkSheets [1] .UsedRange.Rows.Count

For I: = 1 to excelrowcount + 1 do

Begin

Excelx: = excelapp.Cells [iMetro 1] .value

Excely: = excelapp.Cells [iMagazine 2] .value

If ((excelapp.Cells [iMagne1] .value =') and (ExcelApp.Cells [iMagne2] .Value ='') then

/ / specify line I of the excel file, line 1jin2 (as the case may be) and exit if it is empty. This setting had better be yours.

/ / archival power these two lines / / corresponding to the data in the database that cannot be empty

Exit

Else

With adoquery1 do

Begin

Close

Sql.clear

Sql.add ('insert into test (name,address) values (: name,:address)')

The first column of the Parameters.parambyname ('name') .value: = excelx;//excel file is inserted into the name field of the test table

The second column of the Parameters.parambyname ('address') .value: = excely;//excel file is inserted into the address field of the test table

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 iRank 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; / / take the original data field data type

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;// creates an unbound column

Cxitems.Columns [0] .Caption: = 'Select'

/ / cxitems.DataController.CreateAllItems;// establishes all bound columns

/ / dw_checker1.Columns [0] .DataBinding.FieldName: = 'flag'

Cxitems.Columns [0] .width: = 45

/ / the following five lines of statements are used to make the unbound column 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

/ / because the CheckBox column is a dynamic column, you need to associate it with an event of OnChange:

(cxitems.Columns [0] .Properties as TcxCheckBoxProperties) .OnChange:=View_UpCheckBoxColumnPropertiesChange;// associated event

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.

Welcome to subscribe "Shulou Technology Information " to get latest news, interesting things and hot topics in the IT industry, and controls the hottest and latest Internet news, technology news and IT industry trends.