貨品庫(kù)存管理系統(tǒng)-單機(jī)版（2） VBA代碼 源代碼分析 Access數(shù)據(jù)庫(kù)管理系統(tǒng)
?
代碼較多，建議復(fù)制代碼至本地文檔后可按窗體名稱搜索
貨品管理
Option Compare Database
Option Explicit
?
Public update_num As Integer
?
?
Private Sub Command更新_Click()
On Error Resume Next
If 貨品編號(hào) = "" Or IsNull(貨品編號(hào)) = True Then
MsgBox "貨品編號(hào)值為空！"
Exit Sub
End If
update_num = 1
If MsgBox("是否更新該記錄", vbYesNo) <> vbYes Then
DoCmd.RunCommand acCmdUndo
Exit Sub
End If
DoCmd.SetWarnings (False)
On Error Resume Next
DoCmd.RunCommand acCmdSaveRecord
?
Exit Sub
If Error.Number <> 0 Then
MsgBox Error.Description
Else
?
End If
End Sub
?
Private Sub Command刪除_Click()
If MsgBox("是否刪除該記錄", vbYesNo) <> vbYes Then
Exit Sub
End If
On Error Resume Next
DoCmd.SetWarnings (False)
DoCmd.RunCommand acCmdDeleteRecord
MsgBox "刪除成功"
DoCmd.Close acForm, Me.Name
If Error.Number <> 0 Then
MsgBox Error.Description
End If
End Sub
?
?
Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error GoTo 數(shù)據(jù)更新前提醒_Err
?
If update_num = 1 Then
update_num = 0
Exit Sub
End If
?
??? If (MsgBox("是否保存對(duì)記錄的修改", 1, "修改記錄提醒") = 1) Then
??????? Beep
'??????? MsgBox "記錄修改成功", vbyesOnly, "提醒"
??? Else
??????? DoCmd.RunCommand acCmdUndo
??? End If
?
?
數(shù)據(jù)更新前提醒_Exit:
'??? Exit Function
??? Exit Sub
?
數(shù)據(jù)更新前提醒_Err:
??? MsgBox Error$
??? Resume 數(shù)據(jù)更新前提醒_Exit
End Sub
?
Private Sub Form_Close()
On Error Resume Next
Forms("貨品查詢").數(shù)據(jù)表子窗體.Requery
End Sub
?
?
?
貨品類別數(shù)據(jù)表
Private Sub Form_BeforeUpdate(Cancel As Integer)
If gx_num = 0 Then
Exit Sub
End If
?
On Error GoTo 數(shù)據(jù)更新前提醒_Err
?
??? If (MsgBox("是否保存對(duì)記錄的修改", 1, "修改記錄提醒") = 1) Then
??????? Beep
'??????? MsgBox "記錄修改成功", vbyesOnly, "提醒"
??? Else
??????? DoCmd.RunCommand acCmdUndo
??? End If
?
?
數(shù)據(jù)更新前提醒_Exit:
'??? Exit Function
??? Exit Sub
?
數(shù)據(jù)更新前提醒_Err:
??? MsgBox Error$
??? Resume 數(shù)據(jù)更新前提醒_Exit
End Sub
貨品數(shù)據(jù)表
Option Compare Database
?
Private Sub Form_BeforeUpdate(Cancel As Integer)
If gx_num = 0 Then
Exit Sub
End If
?
On Error GoTo 數(shù)據(jù)更新前提醒_Err
?
??? If (MsgBox("是否保存對(duì)記錄的修改", 1, "修改記錄提醒") = 1) Then
??????? Beep
'??????? MsgBox "記錄修改成功", vbyesOnly, "提醒"
??? Else
??????? DoCmd.RunCommand acCmdUndo
??? End If
?
?
數(shù)據(jù)更新前提醒_Exit:
'??? Exit Function
??? Exit Sub
?
數(shù)據(jù)更新前提醒_Err:
??? MsgBox Error$
??? Resume 數(shù)據(jù)更新前提醒_Exit
End Sub
?
Private Sub 貨品編號(hào)_DblClick(Cancel As Integer)
If hp_type = 0 Then
DoCmd.OpenForm "貨品管理", acNormal, , "貨品編號(hào)='" & 貨品編號(hào) & "'"
Exit Sub
End If
If hp_type = 1 Then???? '明細(xì)臺(tái)賬
Forms("明細(xì)臺(tái)賬").選擇貨品.Value = Me.貨品編號(hào)
Forms("明細(xì)臺(tái)賬").貨品編號(hào).Value = ""
mxtz_a1 = 1
DoCmd.Close acForm, "貨品選擇"
Exit Sub
End If
?
If hp_type = 2 Then???? '明細(xì)臺(tái)賬
Forms("出入庫(kù)統(tǒng)計(jì)查詢").選擇貨品.Value = Me.貨品編號(hào)
Forms("出入庫(kù)統(tǒng)計(jì)查詢").數(shù)據(jù)表子窗體.Form.Filter = "貨品編號(hào)='" & Me.貨品編號(hào) & "'"
Forms("出入庫(kù)統(tǒng)計(jì)查詢").數(shù)據(jù)表子窗體.Form.FilterOn = True
DoCmd.Close acForm, "貨品選擇"
Exit Sub
End If
?
If hp_type = 3 Then
rkhp_num = 1
rkhp_text = Me.貨品編號(hào)
DoCmd.Close acForm, "貨品選擇"
Exit Sub
End If
?
If hp_type = 4 Then
ckhp_num = 1
ckhp_text = Me.貨品編號(hào)
DoCmd.Close acForm, "貨品選擇"
Exit Sub
End If
?
End Sub
?
?
貨品添加
Option Compare Database
Option Explicit
?
Private Sub Command導(dǎo)入_Click()
On Error GoTo inputerror
Dim upfilename As String
Dim dlgOpen As FileDialog
Set dlgOpen = Application.FileDialog(msoFileDialogFilePicker)
With dlgOpen
.AllowMultiSelect = False
.Filters.Add "Excel", "*.xlsx; *.xlsm", 1
???? If .Show = -1 Then
??????? upfilename = .SelectedItems(1)
???? Else
??????? Exit Sub
???? End If
End With
?
'------------------------------------------------清空表數(shù)據(jù)
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 本地貨品表"
DoCmd.RunSQL del_sql
'------------------------------------------
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("本地貨品表", dbOpenTable)
'打開(kāi)創(chuàng)建的表并處理數(shù)據(jù)
Dim excelopenpathname As String
excelopenpathname = upfilename???? '復(fù)制粘貼新Excel文件的路徑和名稱
'處理打開(kāi)的表數(shù)據(jù)
Dim xlapp As excel.Application
Dim xlwbk As excel.Workbook
Dim xlwsh As excel.Worksheet
Set xlapp = New excel.Application
Dim CreateExcel As Object
Set CreateExcel = xlapp
xlapp.Visible = True
Set xlwbk = xlapp.WorkBooks.Open(excelopenpathname)
xlwbk.Activate
Set xlwsh = xlwbk.Worksheets(1)
With xlwsh
??? Dim i
??? On Error Resume Next
??? '--------------------------------------------------處理過(guò)程
??? If .cells(2, 1).Value <> "" Then
??? Else
??? GoTo exitexcel
??? End If
??? For i = 2 To .Range("A1").End(xlDown).Row
??????? add_rs.AddNew
add_rs!貨品編號(hào).Value = .cells(i, 1).Value
add_rs!貨品名稱.Value = .cells(i, 2).Value
add_rs!規(guī)格型號(hào).Value = .cells(i, 3).Value
add_rs!單位.Value = .cells(i, 4).Value
add_rs!入庫(kù)價(jià).Value = .cells(i, 5).Value
add_rs!出庫(kù)價(jià).Value = .cells(i, 6).Value
add_rs!貨品類別.Value = .cells(i, 7).Value
add_rs!期初庫(kù)存.Value = .cells(i, 8).Value
add_rs!期初金額.Value = .cells(i, 9).Value
add_rs!最低庫(kù)存.Value = .cells(i, 10).Value
add_rs!最高庫(kù)存.Value = .cells(i, 11).Value
add_rs!備注.Value = .cells(i, 12).Value
?
?
??????? add_rs.Update
??? Next i
End With
exitexcel:
xlwbk.Save
xlwbk.Close
xlapp.Quit
?
'------------------------------------------
Me.數(shù)據(jù)表子窗體.Requery
Exit Sub
inputerror:
MsgBox Err.Description
End Sub
?
Private Sub Command清空_Click()
貨品編號(hào).Value = ""
貨品名稱.Value = ""
規(guī)格型號(hào).Value = ""
單位.Value = ""
入庫(kù)價(jià).Value = ""
出庫(kù)價(jià).Value = ""
貨品類別.Value = ""
期初庫(kù)存.Value = ""
期初金額.Value = ""
最低庫(kù)存.Value = ""
最高庫(kù)存.Value = ""
備注.Value = ""
?
?
End Sub
?
Private Sub Command上傳_Click()
On Error GoTo 上傳數(shù)據(jù)失敗錯(cuò)誤
?
If MsgBox("是否將數(shù)據(jù)添加至貨品表，注意：重復(fù)的貨品編號(hào)將不會(huì)添加", vbOKCancel) <> vbOK Then
Exit Sub
End If
?
If Nz(DCount("貨品編號(hào)", "本地貨品表"), 0) = 0 Then??? '上傳貨品記錄數(shù)量
Exit Sub
End If
?
'---------------------------------------------------------------查詢前端
Dim search_rs As DAO.Recordset
Dim search_sql As String
search_sql = "Select * From 本地貨品表"
Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset)
'---------------------------------------------------------------建立查詢
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("貨品表", dbOpenTable)
'---------------------------------------------------------------
?
On Error Resume Next
Do While search_rs.EOF = False
?
?
If search_rs!貨品編號(hào).Value <> "" Then
add_rs.AddNew
?
add_rs!貨品編號(hào).Value = search_rs!貨品編號(hào).Value
add_rs!貨品名稱.Value = search_rs!貨品名稱.Value
add_rs!規(guī)格型號(hào).Value = search_rs!規(guī)格型號(hào).Value
add_rs!單位.Value = search_rs!單位.Value
add_rs!入庫(kù)價(jià).Value = search_rs!入庫(kù)價(jià).Value
add_rs!出庫(kù)價(jià).Value = search_rs!出庫(kù)價(jià).Value
add_rs!貨品類別.Value = search_rs!貨品類別.Value
add_rs!期初庫(kù)存.Value = search_rs!期初庫(kù)存.Value
add_rs!期初金額.Value = search_rs!期初金額.Value
add_rs!最低庫(kù)存.Value = search_rs!最低庫(kù)存.Value
add_rs!最高庫(kù)存.Value = search_rs!最高庫(kù)存.Value
add_rs!備注.Value = search_rs!備注.Value
?
add_rs.Update
End If
?
search_rs.MoveNext
Loop
'---------------------------------------------------------------斷開(kāi)后端鏈接
?
add_rs.Close
Set add_rs = Nothing
?
'---------------------------------------------------------------斷開(kāi)前端鏈接
search_rs.Close
Set search_rs = Nothing
?
MsgBox "上傳數(shù)據(jù)完成"
Exit Sub
上傳數(shù)據(jù)失敗錯(cuò)誤:
MsgBox "上傳數(shù)據(jù)失??！" & vbCrLf & Err.Description
?
End Sub
?
Private Sub Command添加_Click()
On Error GoTo 添加失敗錯(cuò)誤
?
If 貨品編號(hào) = "" Or IsNull(貨品編號(hào)) = True Then
MsgBox "貨品編號(hào)值為空！"
Exit Sub
End If
?
?
?
If Nz(DCount("貨品編號(hào)", "貨品表", "貨品編號(hào)='" & Me.貨品編號(hào) & "'"), 0) > 0 Then
MsgBox "該貨品編號(hào)已存在！"
Exit Sub
End If
?
?
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("貨品表", dbOpenTable)
add_rs.AddNew
'--------------------------------------------------------------字段賦值
On Error Resume Next
With add_rs
add_rs!貨品編號(hào).Value = 貨品編號(hào).Value
add_rs!貨品名稱.Value = 貨品名稱.Value
add_rs!規(guī)格型號(hào).Value = 規(guī)格型號(hào).Value
add_rs!單位.Value = 單位.Value
add_rs!入庫(kù)價(jià).Value = 入庫(kù)價(jià).Value
add_rs!出庫(kù)價(jià).Value = 出庫(kù)價(jià).Value
add_rs!貨品類別.Value = 貨品類別.Value
add_rs!期初庫(kù)存.Value = 期初庫(kù)存.Value
add_rs!期初金額.Value = 期初金額.Value
add_rs!最低庫(kù)存.Value = 最低庫(kù)存.Value
add_rs!最高庫(kù)存.Value = 最高庫(kù)存.Value
add_rs!備注.Value = 備注.Value
?
?
End With
'----------------------------------------------------------
add_rs.Update
add_rs.Close
Set add_rs = Nothing
'----------------------------------------------------------
?
MsgBox "添加成功！"
Call Command清空_Click
?
Exit Sub
添加失敗錯(cuò)誤:
MsgBox Err.Description
End Sub
?
Private Sub Form_Close()
On Error Resume Next
hp_filter = ""
Forms("貨品查詢").數(shù)據(jù)表子窗體.Requery
?
End Sub
?
Private Sub Form_Load()
DoCmd.Restore
?
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 本地貨品表"
DoCmd.RunSQL del_sql
Me.數(shù)據(jù)表子窗體.Requery
End Sub
?
?
?
?
?
貨品選擇
Option Compare Database
Option Explicit
?
?
Private Sub Command查詢_Click()
On Error GoTo 結(jié)束查詢
Dim search_field As String
If Me.查詢字段 = "日期" Then
?
??? If 起始日期 <> "" And IsNull(起始日期) = False And 截止日期 <> "" And IsNull(截止日期) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then
??????? search_field = Me.查詢字段
??????? hp_filter = search_field & " between #" & Me.起始日期 & "# and #" & Me.截止日期 & "#"
??????? Me.數(shù)據(jù)表子窗體.Form.Filter = hp_filter
??????? Me.數(shù)據(jù)表子窗體.Form.FilterOn = True
??????? Me.數(shù)據(jù)表子窗體.Requery
?
??? Else
??????? hp_filter = ""
??????? Me.數(shù)據(jù)表子窗體.Form.FilterOn = False
??????? Me.數(shù)據(jù)表子窗體.Requery
?
??? End If
??? Me.數(shù)據(jù)表子窗體.SetFocus
??? Exit Sub
End If
If Me.查詢字段 = "入庫(kù)價(jià)" Or Me.查詢字段 = "出庫(kù)價(jià)" Or Me.查詢字段 = "期初庫(kù)存" Or Me.查詢字段 = "期初金額" Or Me.查詢字段 = "最低庫(kù)存" Or Me.查詢字段 = "最高庫(kù)存" Then
??? If 最小 <> "" And IsNull(最小) = False And 最大 <> "" And IsNull(最大) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then
?
?
??????? search_field = Me.查詢字段
??????? hp_filter = search_field & " >= " & Me.最小 & " And " & search_field & " <= " & Me.最大
??????? Me.數(shù)據(jù)表子窗體.Form.Filter = hp_filter
??????? Me.數(shù)據(jù)表子窗體.Form.FilterOn = True
??????? Me.數(shù)據(jù)表子窗體.Requery
??? Else
??????? hp_filter = ""
???? ???Me.數(shù)據(jù)表子窗體.Form.FilterOn = False
??????? Me.數(shù)據(jù)表子窗體.Requery
??? End If
??? Me.數(shù)據(jù)表子窗體.SetFocus
??? Exit Sub
End If
?
If 查詢內(nèi)容 <> "" And IsNull(查詢內(nèi)容) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then
?
??? search_field = Me.查詢字段
??? hp_filter = search_field & " like '*" & Me.查詢內(nèi)容 & "*'"
??? Me.數(shù)據(jù)表子窗體.Form.Filter = hp_filter
??????? Me.數(shù)據(jù)表子窗體.Form.FilterOn = True
??????? Me.數(shù)據(jù)表子窗體.Requery
?
Else
??? hp_filter = ""
??? Me.數(shù)據(jù)表子窗體.Form.FilterOn = False
??????? Me.數(shù)據(jù)表子窗體.Requery
End If
??? Me.數(shù)據(jù)表子窗體.SetFocus
??? Exit Sub
結(jié)束查詢:
??? MsgBox Err.Description
End Sub
?
?
?
?
Private Sub Command全部_Click()
hp_filter = ""
Me.數(shù)據(jù)表子窗體.Form.FilterOn = False
Me.數(shù)據(jù)表子窗體.Requery
End Sub
?
?
?
Private Sub Command數(shù)據(jù)導(dǎo)出_Click()
On Error GoTo 導(dǎo)出失敗
'------------------------------------------------清空表數(shù)據(jù)
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 導(dǎo)出貨品表"
DoCmd.RunSQL del_sql
?
?
?
Dim dflink_sql As String
?
hp_filter = Me.數(shù)據(jù)表子窗體.Form.Filter
?
If hp_filter <> "" And Me.數(shù)據(jù)表子窗體.Form.FilterOn = True Then
dflink_sql = "SELECT * FROM 貨品表 " & " Where " & hp_filter
Else
dflink_sql = "SELECT * FROM 貨品表"
End If
?
hp_order = Me.數(shù)據(jù)表子窗體.Form.OrderBy
?
If hp_order <> "" Then
dflink_sql = dflink_sql & " order by " & hp_order
End If
?
Dim dflink_rs As DAO.Recordset
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
?
With dflink_rs
?
?
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("導(dǎo)出貨品表", dbOpenTable)
Do While .EOF = False
?
add_rs.AddNew
?
add_rs!貨品編號(hào).Value = !貨品編號(hào).Value
add_rs!貨品名稱.Value = !貨品名稱.Value
add_rs!規(guī)格型號(hào).Value = !規(guī)格型號(hào).Value
add_rs!單位.Value = !單位.Value
add_rs!入庫(kù)價(jià).Value = !入庫(kù)價(jià).Value
add_rs!出庫(kù)價(jià).Value = !出庫(kù)價(jià).Value
add_rs!貨品類別.Value = !貨品類別.Value
add_rs!期初庫(kù)存.Value = !期初庫(kù)存.Value
add_rs!期初金額.Value = !期初金額.Value
add_rs!最低庫(kù)存.Value = !最低庫(kù)存.Value
add_rs!最高庫(kù)存.Value = !最高庫(kù)存.Value
add_rs!備注.Value = !備注.Value
?
?
?
add_rs.Update
.MoveNext
Loop
End With
?
add_rs.Close
Set add_rs = Nothing
?
dflink_rs.Close
Set dflink_rs = Nothing
?
?
Call 導(dǎo)出查詢表結(jié)果("導(dǎo)出貨品表")
?
Exit Sub
導(dǎo)出失敗:
MsgBox Err.Description
End Sub
?
Private Sub Command添加_Click()
DoCmd.OpenForm "貨品添加", acNormal
End Sub
?
Private Sub Form_Load()
DoCmd.Restore
?
?
hp_filter = ""
hp_order = "貨品編號(hào) DESC"
?
?
Me.數(shù)據(jù)表子窗體.Form.OrderBy = hp_order
Me.數(shù)據(jù)表子窗體.Form.OrderByOn = True
?
?
Me.查詢內(nèi)容.Visible = True
'-----------------------------隱藏日期控件
Me.起始日期.Visible = False
Me.截止日期.Visible = False
'-----------------------------隱藏金額控件
Me.最小.Visible = False
Me.最大.Visible = False
?
End Sub
Private Sub 查詢字段_Change()
If Me.查詢字段 = "日期" Then
Me.起始日期.Visible = True
Me.截止日期.Visible = True
Me.最小.Visible = False
Me.最大.Visible = False
Me.查詢內(nèi)容.Visible = False
Exit Sub
Else
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = False
Me.最大.Visible = False
Me.查詢內(nèi)容.Visible = True
End If
If Me.查詢字段 = "入庫(kù)價(jià)" Or Me.查詢字段 = "出庫(kù)價(jià)" Or Me.查詢字段 = "期初庫(kù)存" Or Me.查詢字段 = "期初金額" Or Me.查詢字段 = "最低庫(kù)存" Or Me.查詢字段 = "最高庫(kù)存" Then
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = True
Me.最大.Visible = True
Me.查詢內(nèi)容.Visible = False
Exit Sub
Else
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = False
Me.最大.Visible = False
Me.查詢內(nèi)容.Visible = True
End If
End Sub
?
經(jīng)辦人數(shù)據(jù)表
Private Sub Form_BeforeUpdate(Cancel As Integer)
If gx_num = 0 Then
Exit Sub
End If
?
On Error GoTo 數(shù)據(jù)更新前提醒_Err
?
??? If (MsgBox("是否保存對(duì)記錄的修改", 1, "修改記錄提醒") = 1) Then
??????? Beep
'??????? MsgBox "記錄修改成功", vbyesOnly, "提醒"
??? Else
??????? DoCmd.RunCommand acCmdUndo
??? End If
?
?
數(shù)據(jù)更新前提醒_Exit:
'??? Exit Function
??? Exit Sub
?
數(shù)據(jù)更新前提醒_Err:
??? MsgBox Error$
??? Resume 數(shù)據(jù)更新前提醒_Exit
End Sub
庫(kù)存統(tǒng)計(jì)查詢
Option Compare Database
Option Explicit
?
?
Private Sub Command查詢_Click()
On Error GoTo 結(jié)束查詢
Dim search_field As String
If Me.查詢字段 = "日期" Then
?
??? If 起始日期 <> "" And IsNull(起始日期) = False And 截止日期 <> "" And IsNull(截止日期) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then
??????? search_field = Me.查詢字段
??????? kc_filter = search_field & " between #" & Me.起始日期 & "# and #" & Me.截止日期 & "#"
??????? Me.數(shù)據(jù)表子窗體.Form.Filter = kc_filter
??????? Me.數(shù)據(jù)表子窗體.Form.FilterOn = True
??????? Me.數(shù)據(jù)表子窗體.Requery
?
??? Else
??????? kc_filter = ""
??????? Me.數(shù)據(jù)表子窗體.Form.FilterOn = False
??????? Me.數(shù)據(jù)表子窗體.Requery
?
??? End If
??? Me.數(shù)據(jù)表子窗體.SetFocus
??? Exit Sub
End If
If Me.查詢字段 = "入庫(kù)數(shù)量" Or Me.查詢字段 = "出庫(kù)數(shù)量" Or Me.查詢字段 = "當(dāng)前庫(kù)存" Or Me.查詢字段 = "最低庫(kù)存" Or Me.查詢字段 = "最高庫(kù)存" Or Me.查詢字段 = "期初庫(kù)存" Then
??? If 最小 <> "" And IsNull(最小) = False And 最大 <> "" And IsNull(最大) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then
?
?
??????? search_field = Me.查詢字段
??????? kc_filter = search_field & " >= " & Me.最小 & " And " & search_field & " <= " & Me.最大
??????? Me.數(shù)據(jù)表子窗體.Form.Filter = kc_filter
??????? Me.數(shù)據(jù)表子窗體.Form.FilterOn = True
??????? Me.數(shù)據(jù)表子窗體.Requery
??? Else
??????? kc_filter = ""
??????? Me.數(shù)據(jù)表子窗體.Form.FilterOn = False
??????? Me.數(shù)據(jù)表子窗體.Requery
??? End If
??? Me.數(shù)據(jù)表子窗體.SetFocus
??? Exit Sub
End If
?
If 查詢內(nèi)容 <> "" And IsNull(查詢內(nèi)容) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then
?
??? search_field = Me.查詢字段
??? kc_filter = search_field & " like '*" & Me.查詢內(nèi)容 & "*'"
??? Me.數(shù)據(jù)表子窗體.Form.Filter = kc_filter
??????? Me.數(shù)據(jù)表子窗體.Form.FilterOn = True
??????? Me.數(shù)據(jù)表子窗體.Requery
?
Else
??? kc_filter = ""
??? Me.數(shù)據(jù)表子窗體.Form.FilterOn = False
??????? Me.數(shù)據(jù)表子窗體.Requery
End If
??? Me.數(shù)據(jù)表子窗體.SetFocus
??? Exit Sub
結(jié)束查詢:
??? MsgBox Err.Description
End Sub
?
?
Private Sub Command全部_Click()
kc_filter = ""
Me.數(shù)據(jù)表子窗體.Form.FilterOn = False
Me.數(shù)據(jù)表子窗體.Requery
End Sub
?
?
?
Private Sub Command數(shù)據(jù)導(dǎo)出_Click()
On Error GoTo 導(dǎo)出失敗
'------------------------------------------------清空表數(shù)據(jù)
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 導(dǎo)出庫(kù)存統(tǒng)計(jì)表"
DoCmd.RunSQL del_sql
?
?
?
Dim dflink_sql As String
?
kc_filter = Me.數(shù)據(jù)表子窗體.Form.Filter
?
If kc_filter <> "" And Me.數(shù)據(jù)表子窗體.Form.FilterOn = True Then
dflink_sql = "SELECT * FROM 庫(kù)存統(tǒng)計(jì)查詢 " & " Where " & kc_filter
Else
dflink_sql = "SELECT * FROM 庫(kù)存統(tǒng)計(jì)查詢"
End If
?
kc_order = Me.數(shù)據(jù)表子窗體.Form.OrderBy
?
If kc_order <> "" Then
dflink_sql = dflink_sql & " order by " & kc_order
End If
?
Dim dflink_rs As DAO.Recordset
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
?
With dflink_rs
?
?
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("導(dǎo)出庫(kù)存統(tǒng)計(jì)表", dbOpenTable)
Do While .EOF = False
?
add_rs.AddNew
?
add_rs!貨品編號(hào).Value = !貨品編號(hào).Value
add_rs!貨品名稱.Value = !貨品名稱.Value
add_rs!規(guī)格型號(hào).Value = !規(guī)格型號(hào).Value
add_rs!單位.Value = !單位.Value
add_rs!入庫(kù)數(shù)量.Value = !入庫(kù)數(shù)量.Value
add_rs!出庫(kù)數(shù)量.Value = !出庫(kù)數(shù)量.Value
add_rs!當(dāng)前庫(kù)存.Value = !當(dāng)前庫(kù)存.Value
add_rs!最低庫(kù)存.Value = !最低庫(kù)存.Value
add_rs!最高庫(kù)存.Value = !最高庫(kù)存.Value
add_rs!最低庫(kù)存狀態(tài).Value = !最低庫(kù)存狀態(tài).Value
add_rs!最高庫(kù)存狀態(tài).Value = !最高庫(kù)存狀態(tài).Value
add_rs!貨品類別.Value = !貨品類別.Value
add_rs!期初庫(kù)存.Value = !期初庫(kù)存.Value
?
add_rs.Update
.MoveNext
Loop
End With
?
add_rs.Close
Set add_rs = Nothing
?
dflink_rs.Close
Set dflink_rs = Nothing
?
?
Call 導(dǎo)出查詢表結(jié)果("導(dǎo)出庫(kù)存統(tǒng)計(jì)表")
?
Exit Sub
導(dǎo)出失敗:
MsgBox Err.Description
End Sub
?
Private Sub Command添加_Click()
DoCmd.OpenForm "庫(kù)存統(tǒng)計(jì)添加", acNormal
End Sub
?
Private Sub Form_Load()
DoCmd.Restore
?
?
kc_filter = ""
kc_order = ""
?
?
Me.查詢內(nèi)容.Visible = True
'-----------------------------隱藏日期控件
Me.起始日期.Visible = False
Me.截止日期.Visible = False
'-----------------------------隱藏金額控件
Me.最小.Visible = False
Me.最大.Visible = False
?
End Sub
Private Sub 查詢字段_Change()
If Me.查詢字段 = "日期" Then
Me.起始日期.Visible = True
Me.截止日期.Visible = True
Me.最小.Visible = False
Me.最大.Visible = False
Me.查詢內(nèi)容.Visible = False
Exit Sub
Else
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = False
Me.最大.Visible = False
Me.查詢內(nèi)容.Visible = True
End If
If Me.查詢字段 = "入庫(kù)數(shù)量" Or Me.查詢字段 = "出庫(kù)數(shù)量" Or Me.查詢字段 = "當(dāng)前庫(kù)存" Or Me.查詢字段 = "最低庫(kù)存" Or Me.查詢字段 = "最高庫(kù)存" Or Me.查詢字段 = "期初庫(kù)存" Then
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = True
Me.最大.Visible = True
Me.查詢內(nèi)容.Visible = False
Exit Sub
Else
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = False
Me.最大.Visible = False
Me.查詢內(nèi)容.Visible = True
End If
End Sub
?
領(lǐng)用單位數(shù)據(jù)表
Private Sub Form_BeforeUpdate(Cancel As Integer)
If gx_num = 0 Then
Exit Sub
End If
?
On Error GoTo 數(shù)據(jù)更新前提醒_Err
?
??? If (MsgBox("是否保存對(duì)記錄的修改", 1, "修改記錄提醒") = 1) Then
??????? Beep
'??????? MsgBox "記錄修改成功", vbyesOnly, "提醒"
??? Else
??????? DoCmd.RunCommand acCmdUndo
??? End If
?
?
數(shù)據(jù)更新前提醒_Exit:
'??? Exit Function
??? Exit Sub
?
數(shù)據(jù)更新前提醒_Err:
??? MsgBox Error$
??? Resume 數(shù)據(jù)更新前提醒_Exit
End Sub
明細(xì)臺(tái)賬
Option Compare Database
Option Explicit
?
?
Public 期初庫(kù)存num As Single
Public 期初金額num As Currency
?
?
?
Private Sub Command查詢_Click()
If Me.貨品編號(hào) <> "" Then
Call 獲取貨品明細(xì)臺(tái)賬(Me.貨品編號(hào))
End If
Me.數(shù)據(jù)表子窗體.Requery
End Sub
?
Private Sub Command打印臺(tái)賬_Click()
On Error GoTo outputerror
?
'------------------------------------------
Dim copyfilename As String
copyfilename = "明細(xì)臺(tái)賬.xlsx"??? '要復(fù)制的源文件（Excel）
'---------------------------------輸入文件名
Dim outputname As String
outputname = InputBox("請(qǐng)輸入導(dǎo)出的文件名", "導(dǎo)出明細(xì)臺(tái)賬", "明細(xì)臺(tái)賬：" & Me.貨品編號(hào) & " " & Me.貨品名稱)?????? '---------------------------------------------------輸入要生成的表名
If outputname = "" Or IsNull(outputname) Then?? '為空則不執(zhí)行程序
'GoTo outputerror
Exit Sub
End If
'----------------------------------選擇導(dǎo)出的位置（文件夾）
Dim exportpath As String
Dim dlgOpen As FileDialog
Set dlgOpen = Application.FileDialog(msoFileDialogFolderPicker)
With dlgOpen
???? If .Show = -1 Then
??????? exportpath = .SelectedItems(1)
??????? Else
??????? Exit Sub
??? ?End If
End With
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
??? fs.copyfile fs.BuildPath(CurrentProject.Path, copyfilename), exportpath & "\" & outputname & ".xlsx"
'================================================================================打開(kāi)創(chuàng)建的表并處理數(shù)據(jù)
Dim excelopenpathname As String
excelopenpathname = exportpath & "\" & outputname & ".xlsx"???? '復(fù)制粘貼新Excel文件的路徑和名稱
'================================================================================處理打開(kāi)的表數(shù)據(jù)
?
?
?
?
Dim xlapp As Object
Set xlapp = CreateObject("excel.application")
Dim xlwbk As Object
Dim xlwsh As Object
?
?
Dim CreateExcel As Object
Set CreateExcel = xlapp
xlapp.Visible = False
Set xlwbk = xlapp.WorkBooks.Open(excelopenpathname)
xlwbk.Activate
Set xlwsh = xlwbk.Worksheets(1)
With xlwsh
??? '--------------------------------------------------處理過(guò)程
??? .cells(3, "C").Value = Me.貨品編號(hào).Value
??? .cells(4, "C").Value = Me.貨品名稱.Value
??? .cells(5, "C").Value = Me.規(guī)格型號(hào).Value
??? .cells(3, "J").Value = Me.貨品類別.Value
??? .cells(6, "M").Value = Me.單位.Value
?
End With
?
With xlwsh
'****************************************************************循環(huán)采購(gòu)出庫(kù)查詢
?
Dim search_sql As String
?
search_sql = "SELECT * FROM 明細(xì)臺(tái)賬表"
?
Dim search_rs As DAO.Recordset
?
?
Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset)
?
'------------------------------------------------------------------
Dim add_row As Long
add_row = 9
Do While search_rs.EOF = False
?
.cells(add_row, 2).Value = search_rs!日期.Value
.cells(add_row, 3).Value = search_rs!憑證單號(hào).Value
.cells(add_row, 4).Value = search_rs!出入庫(kù)摘要.Value
.cells(add_row, 5).Value = search_rs!入庫(kù)數(shù)量.Value
.cells(add_row, 6).Value = search_rs!入庫(kù)單價(jià).Value
.cells(add_row, 9).Value = search_rs!入庫(kù)金額.Value
.cells(add_row, 7).Value = search_rs!出庫(kù)數(shù)量.Value
.cells(add_row, 8).Value = search_rs!出庫(kù)單價(jià).Value
.cells(add_row, 10).Value = search_rs!出庫(kù)金額.Value
.cells(add_row, 11).Value = search_rs!結(jié)存數(shù)量.Value
.cells(add_row, 12).Value = search_rs!結(jié)存均價(jià).Value
.cells(add_row, 13).Value = search_rs!結(jié)存金額.Value
?
.Range(.cells(add_row, 2), .cells(add_row, 13)).Borders.LineStyle = 1
add_row = add_row + 1
search_rs.MoveNext
Loop
?
?
'------------------------------------------------------------------
search_rs.Close
Set search_rs = Nothing
?
?
'****************************************************************
.Columns.AutoFit
End With
?
xlwbk.Save
xlwbk.Close
xlapp.Quit
MsgBox "導(dǎo)出完成"
?
'------------------------------------------
Exit Sub
outputerror:
MsgBox "導(dǎo)出數(shù)據(jù)出錯(cuò)，請(qǐng)檢查！可能存在同名工作簿" & vbCrLf & Err.Description
End Sub
?
Private Sub Command全部_Click()
mxtz_filter = ""
Me.數(shù)據(jù)表子窗體.Form.FilterOn = False
Me.數(shù)據(jù)表子窗體.Requery
End Sub
?
Private Sub Form_Load()
'---------------------------------------初始化刪除顯示表
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 明細(xì)臺(tái)賬表"
DoCmd.RunSQL del_sql
?
'---------------------------------------
Me.數(shù)據(jù)表子窗體.SourceObject = ""
Me.數(shù)據(jù)表子窗體.SourceObject = "明細(xì)臺(tái)賬數(shù)據(jù)表"
End Sub
?
Private Sub Form_Timer()
If mxtz_a1 = 1 Then
Call 貨品基礎(chǔ)信息
mxtz_a1 = 0
End If
End Sub
?
Private Sub 選擇貨品_AfterUpdate()
If Me.選擇貨品 <> "" Then
?
Dim search_rs As DAO.Recordset
Dim search_sql As String
search_sql = "Select * From 貨品表 Where 貨品編號(hào)='" & Me.選擇貨品 & "'"
Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset)
?
If search_rs.EOF = False Then
?
貨品編號(hào).Value = search_rs!貨品編號(hào).Value
貨品名稱.Value = search_rs!貨品名稱.Value
規(guī)格型號(hào).Value = search_rs!規(guī)格型號(hào).Value
單位.Value = search_rs!單位.Value
?
貨品類別.Value = search_rs!貨品類別.Value
'----------------------------------------------------
期初庫(kù)存num = Nz(search_rs!期初庫(kù)存.Value, 0)
期初金額num = Nz(search_rs!期初金額.Value, 0)
'----------------------------------------------------
Else
貨品編號(hào).Value = ""
貨品名稱.Value = ""
規(guī)格型號(hào).Value = ""
單位.Value = ""
貨品類別.Value = ""
'----------------------------------------------------
期初庫(kù)存num = 0
期初金額num = 0
'----------------------------------------------------
End If
search_rs.Close
?
Set search_rs = Nothing
?
Else
?
貨品編號(hào).Value = ""
貨品名稱.Value = ""
規(guī)格型號(hào).Value = ""
單位.Value = ""
貨品類別.Value = ""
'----------------------------------------------------
期初庫(kù)存num = 0
期初金額num = 0
'----------------------------------------------------
End If
End Sub
?
Private Sub 選擇貨品_Change()
If Me.選擇貨品 <> "" Then
?
Dim search_rs As DAO.Recordset
Dim search_sql As String
search_sql = "Select * From 貨品表 Where 貨品編號(hào)='" & Me.選擇貨品 & "'"
Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset)
?
If search_rs.EOF = False Then
?
貨品編號(hào).Value = search_rs!貨品編號(hào).Value
貨品名稱.Value = search_rs!貨品名稱.Value
規(guī)格型號(hào).Value = search_rs!規(guī)格型號(hào).Value
單位.Value = search_rs!單位.Value
?
貨品類別.Value = search_rs!貨品類別.Value
'----------------------------------------------------
期初庫(kù)存num = Nz(search_rs!期初庫(kù)存.Value, 0)
期初金額num = Nz(search_rs!期初金額.Value, 0)
'----------------------------------------------------
Else
貨品編號(hào).Value = ""
貨品名稱.Value = ""
規(guī)格型號(hào).Value = ""
單位.Value = ""
貨品類別.Value = ""
'----------------------------------------------------
期初庫(kù)存num = 0
期初金額num = 0
'----------------------------------------------------
End If
search_rs.Close
?
Set search_rs = Nothing
?
Else
?
貨品編號(hào).Value = ""
貨品名稱.Value = ""
規(guī)格型號(hào).Value = ""
單位.Value = ""
貨品類別.Value = ""
'----------------------------------------------------
期初庫(kù)存num = 0
期初金額num = 0
'----------------------------------------------------
End If
End Sub
?
?
Sub 獲取貨品明細(xì)臺(tái)賬(ByVal hpname As String)
'----------------------------------------------------刪除原表記錄
On Error GoTo 導(dǎo)出失敗
?
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 明細(xì)臺(tái)賬表"
DoCmd.RunSQL del_sql
?
?
?
'----------------------------------------------------獲取明細(xì)記錄循環(huán)計(jì)算添加
Dim dflink_sql As String
dflink_sql = "SELECT * FROM 出入庫(kù)明細(xì)查詢 where 貨品編號(hào)='" & Me.貨品編號(hào) & "' order by 出入庫(kù)日期 ASC"
?
?
Dim dflink_rs As DAO.Recordset
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
?
With dflink_rs
?
?
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("明細(xì)臺(tái)賬表", dbOpenTable)
'-------------------------添加期初數(shù)據(jù)
add_rs.AddNew
?
?
add_rs!憑證單號(hào).Value = "期初"
add_rs!出入庫(kù)摘要.Value = "期初"
add_rs!入庫(kù)數(shù)量.Value = 0
add_rs!入庫(kù)單價(jià).Value = 0
add_rs!入庫(kù)金額.Value = 0
add_rs!出庫(kù)數(shù)量.Value = 0
add_rs!出庫(kù)單價(jià).Value = 0
add_rs!出庫(kù)金額.Value = 0
add_rs!結(jié)存數(shù)量.Value = 期初庫(kù)存num
If 期初庫(kù)存num <> 0 Then
add_rs!結(jié)存均價(jià).Value = CCur(期初金額num / 期初庫(kù)存num)
Else
add_rs!結(jié)存均價(jià).Value = 0
End If
add_rs!結(jié)存金額.Value = 期初金額num
add_rs.Update
'-------------------------
Dim 上期金額num As Currency
Dim 入庫(kù)金額num As Currency
Dim 出庫(kù)金額num As Currency
?
Dim 入庫(kù)數(shù)量num As Single
Dim 出庫(kù)數(shù)量num As Single
?
Dim 入庫(kù)單價(jià)num As Currency
Dim 出庫(kù)單價(jià)num As Currency
?
Dim 出入庫(kù)摘要text As String
上期金額num = 期初金額num
?
Dim 結(jié)存數(shù)量num As Single
Dim 結(jié)存均價(jià)num As Currency
Dim 結(jié)存金額num As Currency
?
Dim 上期數(shù)量num As Single
Dim 上期均價(jià)num As Currency
?
上期數(shù)量num = 期初庫(kù)存num
??? If 期初庫(kù)存num <> 0 Then
??? 上期均價(jià)num = Nz(CCur(期初金額num / 期初庫(kù)存num), 0)
??? Else
??? 上期均價(jià)num = 0
??? End If
Do While .EOF = False
入庫(kù)金額num = 0
入庫(kù)數(shù)量num = 0
入庫(kù)單價(jià)num = 0
?
出庫(kù)金額num = 0
出庫(kù)數(shù)量num = 0
出庫(kù)單價(jià)num = 0
If !出入庫(kù).Value = "入庫(kù)" Then
?
入庫(kù)金額num = !貨品金額.Value
入庫(kù)數(shù)量num = !數(shù)量.Value
入庫(kù)單價(jià)num = !單價(jià).Value
?
出庫(kù)金額num = 0
出庫(kù)數(shù)量num = 0
出庫(kù)單價(jià)num = 0
End If
If !出入庫(kù).Value = "出庫(kù)" Then
出庫(kù)金額num = !貨品金額.Value
出庫(kù)數(shù)量num = !數(shù)量.Value
出庫(kù)單價(jià)num = !單價(jià).Value
?
入庫(kù)金額num = 0
入庫(kù)數(shù)量num = 0
入庫(kù)單價(jià)num = 0
End If
?
?
出入庫(kù)摘要text = !出入庫(kù)類別.Value & "-" & !出入庫(kù).Value
'--------------------------------計(jì)算結(jié)存
結(jié)存金額num = 上期金額num + 入庫(kù)金額num - 出庫(kù)金額num
上期金額num = 結(jié)存金額num
結(jié)存數(shù)量num = 上期數(shù)量num + 入庫(kù)數(shù)量num - 出庫(kù)數(shù)量num
上期數(shù)量num = 結(jié)存數(shù)量num
If 結(jié)存數(shù)量num <> 0 Then
結(jié)存均價(jià)num = Nz(結(jié)存金額num / 結(jié)存數(shù)量num)
Else
結(jié)存均價(jià)num = 0
End If
'--------------------------------
?
?
add_rs.AddNew
?
add_rs!日期.Value = !出入庫(kù)日期.Value
add_rs!憑證單號(hào).Value = !憑證單號(hào).Value
add_rs!出入庫(kù)摘要.Value = 出入庫(kù)摘要text
add_rs!入庫(kù)數(shù)量.Value = 入庫(kù)數(shù)量num
add_rs!入庫(kù)單價(jià).Value = 入庫(kù)單價(jià)num
add_rs!入庫(kù)金額.Value = 入庫(kù)金額num
add_rs!出庫(kù)數(shù)量.Value = 出庫(kù)數(shù)量num
add_rs!出庫(kù)單價(jià).Value = 出庫(kù)單價(jià)num
add_rs!出庫(kù)金額.Value = 出庫(kù)金額num
add_rs!結(jié)存數(shù)量.Value = 結(jié)存數(shù)量num
add_rs!結(jié)存均價(jià).Value = 結(jié)存均價(jià)num
add_rs!結(jié)存金額.Value = 結(jié)存金額num
?
add_rs.Update
?
.MoveNext
Loop
End With
?
add_rs.Close
Set add_rs = Nothing
?
dflink_rs.Close
Set dflink_rs = Nothing
?
?
'------------------------------------------------------
Exit Sub
導(dǎo)出失敗:
MsgBox Err.Description
End Sub
?
Private Sub 選擇貨品_DblClick(Cancel As Integer)
hp_type = 1
DoCmd.OpenForm "貨品選擇", acNormal
End Sub
?
?
?
Sub 貨品基礎(chǔ)信息()
If Me.選擇貨品 <> "" Then
?
Dim search_rs As DAO.Recordset
Dim search_sql As String
search_sql = "Select * From 貨品表 Where 貨品編號(hào)='" & Me.選擇貨品 & "'"
Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset)
?
If search_rs.EOF = False Then
?
貨品編號(hào).Value = search_rs!貨品編號(hào).Value
貨品名稱.Value = search_rs!貨品名稱.Value
規(guī)格型號(hào).Value = search_rs!規(guī)格型號(hào).Value
單位.Value = search_rs!單位.Value
?
貨品類別.Value = search_rs!貨品類別.Value
'----------------------------------------------------
期初庫(kù)存num = Nz(search_rs!期初庫(kù)存.Value, 0)
期初金額num = Nz(search_rs!期初金額.Value, 0)
'----------------------------------------------------
Else
貨品編號(hào).Value = ""
貨品名稱.Value = ""
規(guī)格型號(hào).Value = ""
單位.Value = ""
貨品類別.Value = ""
'----------------------------------------------------
期初庫(kù)存num = 0
期初金額num = 0
'----------------------------------------------------
End If
search_rs.Close
?
Set search_rs = Nothing
?
Else
?
貨品編號(hào).Value = ""
貨品名稱.Value = ""
規(guī)格型號(hào).Value = ""
單位.Value = ""
貨品類別.Value = ""
'----------------------------------------------------
期初庫(kù)存num = 0
期初金額num = 0
'----------------------------------------------------
End If
End Sub
?
入庫(kù)單查詢
Option Compare Database
Option Explicit
?
?
Private Sub Command查詢_Click()
On Error GoTo 結(jié)束查詢
Dim search_field As String
If Me.查詢字段 = "入庫(kù)日期" Then
?
??? If 起始日期 <> "" And IsNull(起始日期) = False And 截止日期 <> "" And IsNull(截止日期) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then
??????? search_field = Me.查詢字段
??????? rk_filter = search_field & " between #" & Me.起始日期 & "# and #" & Me.截止日期 & "#"
??????? Me.數(shù)據(jù)表子窗體.Form.Filter = rk_filter
??????? Me.數(shù)據(jù)表子窗體.Form.FilterOn = True
??????? Me.數(shù)據(jù)表子窗體.Requery
?
??? Else
??????? rk_filter = ""
??????? Me.數(shù)據(jù)表子窗體.Form.FilterOn = False
??????? Me.數(shù)據(jù)表子窗體.Requery
?
??? End If
??? Me.數(shù)據(jù)表子窗體.SetFocus
??? Exit Sub
End If
If Me.查詢字段 = "金額" Then
??? If 最小 <> "" And IsNull(最小) = False And 最大 <> "" And IsNull(最大) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then
?
?
??????? search_field = Me.查詢字段
??????? rk_filter = search_field & " >= " & Me.最小 & " And " & search_field & " <= " & Me.最大
??????? Me.數(shù)據(jù)表子窗體.Form.Filter = rk_filter
??????? Me.數(shù)據(jù)表子窗體.Form.FilterOn = True
??????? Me.數(shù)據(jù)表子窗體.Requery
??? Else
??????? rk_filter = ""
??????? Me.數(shù)據(jù)表子窗體.Form.FilterOn = False
??????? Me.數(shù)據(jù)表子窗體.Requery
??? End If
??? Me.數(shù)據(jù)表子窗體.SetFocus
??? Exit Sub
End If
?
If 查詢內(nèi)容 <> "" And IsNull(查詢內(nèi)容) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then
?
??? search_field = Me.查詢字段
??? rk_filter = search_field & " like '*" & Me.查詢內(nèi)容 & "*'"
??? Me.數(shù)據(jù)表子窗體.Form.Filter = rk_filter
??????? Me.數(shù)據(jù)表子窗體.Form.FilterOn = True
??????? Me.數(shù)據(jù)表子窗體.Requery
?
Else
??? rk_filter = ""
??? Me.數(shù)據(jù)表子窗體.Form.FilterOn = False
??????? Me.數(shù)據(jù)表子窗體.Requery
End If
??? Me.數(shù)據(jù)表子窗體.SetFocus
??? Exit Sub
結(jié)束查詢:
??? MsgBox Err.Description
End Sub
?
?
?
?
?
Private Sub Command全部_Click()
rk_filter = ""
Me.數(shù)據(jù)表子窗體.Form.FilterOn = False
Me.數(shù)據(jù)表子窗體.Requery
End Sub
?
?
?
Private Sub Command數(shù)據(jù)導(dǎo)出_Click()
On Error GoTo 導(dǎo)出失敗
'------------------------------------------------清空表數(shù)據(jù)
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 導(dǎo)出入庫(kù)單表"
DoCmd.RunSQL del_sql
?
?
?
Dim dflink_sql As String
?
rk_filter = Me.數(shù)據(jù)表子窗體.Form.Filter
?
If rk_filter <> "" And Me.數(shù)據(jù)表子窗體.Form.FilterOn = True Then
dflink_sql = "SELECT * FROM 入庫(kù)單查詢 " & " Where " & rk_filter
Else
dflink_sql = "SELECT * FROM 入庫(kù)單查詢"
End If
?
rk_order = Me.數(shù)據(jù)表子窗體.Form.OrderBy
?
If rk_order <> "" Then
dflink_sql = dflink_sql & " order by " & rk_order
End If
?
Dim dflink_rs As DAO.Recordset
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
?
With dflink_rs
?
?
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("導(dǎo)出入庫(kù)單表", dbOpenTable)
Do While .EOF = False
?
add_rs.AddNew
?
add_rs!入庫(kù)單號(hào).Value = !入庫(kù)單號(hào).Value
add_rs!供貨單位.Value = !供貨單位.Value
add_rs!入庫(kù)類別.Value = !入庫(kù)類別.Value
add_rs!入庫(kù)日期.Value = !入庫(kù)日期.Value
add_rs!供貨人.Value = !供貨人.Value
add_rs!經(jīng)辦人.Value = !經(jīng)辦人.Value
add_rs!備注.Value = !備注.Value
add_rs!金額.Value = !金額.Value
?
add_rs.Update
.MoveNext
Loop
End With
?
add_rs.Close
Set add_rs = Nothing
?
dflink_rs.Close
Set dflink_rs = Nothing
?
?
Call 導(dǎo)出查詢表結(jié)果("導(dǎo)出入庫(kù)單表")
?
Exit Sub
導(dǎo)出失敗:
MsgBox Err.Description
End Sub
?
Private Sub Command添加_Click()
DoCmd.OpenForm "入庫(kù)單添加", acNormal
End Sub
?
Private Sub Form_Load()
DoCmd.Restore
?
?
rk_filter = ""
rk_order = "入庫(kù)單號(hào) DESC"
?
'Me.數(shù)據(jù)表子窗體.Form.OrderBy = rk_order
'Me.數(shù)據(jù)表子窗體.Form.OrderByOn = True
?
Me.查詢內(nèi)容.Visible = True
'-----------------------------隱藏日期控件
Me.起始日期.Visible = False
Me.截止日期.Visible = False
'-----------------------------隱藏金額控件
Me.最小.Visible = False
Me.最大.Visible = False
?
End Sub
Private Sub 查詢字段_Change()
If Me.查詢字段 = "入庫(kù)日期" Then
Me.起始日期.Visible = True
Me.截止日期.Visible = True
Me.最小.Visible = False
Me.最大.Visible = False
Me.查詢內(nèi)容.Visible = False
Exit Sub
Else
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = False
Me.最大.Visible = False
Me.查詢內(nèi)容.Visible = True
End If
If Me.查詢字段 = "金額" Then
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = True
Me.最大.Visible = True
Me.查詢內(nèi)容.Visible = False
Exit Sub
Else
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = False
Me.最大.Visible = False
Me.查詢內(nèi)容.Visible = True
End If
End Sub
?
入庫(kù)單查詢數(shù)據(jù)表
Private Sub 入庫(kù)單號(hào)_DblClick(Cancel As Integer)
DoCmd.OpenForm "入庫(kù)單管理", acNormal, , "入庫(kù)單號(hào)='" & 入庫(kù)單號(hào) & "'"
End Sub
入庫(kù)單管理
Option Compare Database
Option Explicit
?
Public update_num As Integer
?
?
?
Private Sub Command更新_Click()
On Error Resume Next
If 入庫(kù)單號(hào) = "" Or IsNull(入庫(kù)單號(hào)) = True Then
MsgBox "入庫(kù)單號(hào)值為空！"
Exit Sub
End If
?
update_num = 1
If MsgBox("是否更新該記錄", vbYesNo) <> vbYes Then
DoCmd.RunCommand acCmdUndo
Exit Sub
End If
DoCmd.SetWarnings (False)
On Error Resume Next
DoCmd.RunCommand acCmdSaveRecord
?
Exit Sub
If Error.Number <> 0 Then
MsgBox Error.Description
Else
?
End If
End Sub
?
Private Sub Command入庫(kù)單_Click()
On Error GoTo outputerror
?
'------------------------------------------
Dim copyfilename As String
copyfilename = "入庫(kù)單.xlsx"??? '要復(fù)制的源文件（Excel）
'---------------------------------輸入文件名
Dim outputname As String
outputname = InputBox("請(qǐng)輸入導(dǎo)出的文件名", "導(dǎo)出入庫(kù)單", "入庫(kù)單" & Me.入庫(kù)單號(hào))?????? '---------------------------------------------------輸入要生成的表名
If outputname = "" Or IsNull(outputname) Then?? '為空則不執(zhí)行程序
'GoTo outputerror
Exit Sub
End If
'----------------------------------選擇導(dǎo)出的位置（文件夾）
Dim exportpath As String
Dim dlgOpen As FileDialog
Set dlgOpen = Application.FileDialog(msoFileDialogFolderPicker)
With dlgOpen
???? If .Show = -1 Then
??????? exportpath = .SelectedItems(1)
??????? Else
??????? Exit Sub
???? End If
End With
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
??? fs.copyfile fs.BuildPath(CurrentProject.Path, copyfilename), exportpath & "\" & outputname & ".xlsx"
'================================================================================打開(kāi)創(chuàng)建的表并處理數(shù)據(jù)
Dim excelopenpathname As String
excelopenpathname = exportpath & "\" & outputname & ".xlsx"???? '復(fù)制粘貼新Excel文件的路徑和名稱
'================================================================================處理打開(kāi)的表數(shù)據(jù)
?
?
?
?
Dim xlapp As Object
Set xlapp = CreateObject("excel.application")
Dim xlwbk As Object
Dim xlwsh As Object
?
?
Dim CreateExcel As Object
Set CreateExcel = xlapp
xlapp.Visible = False
Set xlwbk = xlapp.WorkBooks.Open(excelopenpathname)
xlwbk.Activate
Set xlwsh = xlwbk.Worksheets(1)
With xlwsh
??? '--------------------------------------------------處理過(guò)程
??? .cells(1, "K").Value = Me.入庫(kù)單號(hào).Value
??? .cells(3, "D").Value = Me.供貨單位.Value
??? .cells(3, "H").Value = Me.入庫(kù)類別.Value
??? .cells(3, "K").Value = Me.入庫(kù)日期.Value
??? .cells(6, "K").Value = Me.金額.Value
??? .cells(7, "D").Value = Me.供貨人.Value
??? .cells(7, "K").Value = Me.經(jīng)辦人.Value
??? .cells(8, "D").Value = Me.備注.Value
? ??.cells(6, "D").Value = rmb(Me.金額)
End With
'Set xlwsh = xlwbk.Worksheets(2)
With xlwsh
'****************************************************************循環(huán)采購(gòu)入庫(kù)查詢
?
Dim search_sql As String
?
search_sql = "SELECT * FROM 入庫(kù)明細(xì)查詢 " & " Where 入庫(kù)單號(hào)='" & Me.入庫(kù)單號(hào) & "' Order by 入庫(kù)序號(hào) ASC"
?
Dim search_rs As DAO.Recordset
?
'MsgBox search_sql
Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset)
?
'------------------------------------------------------------------
Dim add_row As Long
add_row = 5
Do While search_rs.EOF = False
.rows(add_row).Insert
?
.cells(add_row, 2).Value = search_rs!入庫(kù)序號(hào).Value
.cells(add_row, 3).Value = search_rs!貨品編號(hào).Value
.cells(add_row, 4).Value = search_rs!貨品名稱.Value
.cells(add_row, 5).Value = search_rs!規(guī)格型號(hào).Value
.cells(add_row, 6).Value = search_rs!貨品類別.Value
.cells(add_row, 9).Value = search_rs!單位.Value
.cells(add_row, 7).Value = search_rs!單價(jià).Value
.cells(add_row, 8).Value = search_rs!數(shù)量.Value
.cells(add_row, 10).Value = search_rs!貨品金額.Value
.cells(add_row, 11).Value = search_rs!明細(xì)備注.Value
?
add_row = add_row + 1
search_rs.MoveNext
Loop
?
?
'------------------------------------------------------------------
search_rs.Close
Set search_rs = Nothing
?
?
'****************************************************************
End With
xlwbk.Save
xlwbk.Close
xlapp.Quit
MsgBox "導(dǎo)出完成"
?
'------------------------------------------
Exit Sub
outputerror:
MsgBox "導(dǎo)出數(shù)據(jù)出錯(cuò)，請(qǐng)檢查！可能存在同名工作簿" & vbCrLf & Err.Description
End Sub
?
Private Sub Command刪除_Click()
If MsgBox("是否刪除該記錄", vbYesNo) <> vbYes Then
Exit Sub
End If
On Error Resume Next
DoCmd.SetWarnings (False)
DoCmd.RunCommand acCmdDeleteRecord
MsgBox "刪除成功"
DoCmd.Close acForm, Me.Name
If Error.Number <> 0 Then
MsgBox Error.Description
End If
End Sub
?
?
?
?
Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error GoTo 數(shù)據(jù)更新前提醒_Err
?
If update_num = 1 Then
update_num = 0
Exit Sub
End If
?
??? If (MsgBox("是否保存對(duì)記錄的修改", 1, "修改記錄提醒") = 1) Then
?? ?????Beep
'??????? MsgBox "記錄修改成功", vbyesOnly, "提醒"
??? Else
??????? DoCmd.RunCommand acCmdUndo
??? End If
?
?
數(shù)據(jù)更新前提醒_Exit:
'??? Exit Function
??? Exit Sub
?
數(shù)據(jù)更新前提醒_Err:
??? MsgBox Error$
??? Resume 數(shù)據(jù)更新前提醒_Exit
End Sub
?
Private Sub Form_Close()
On Error Resume Next
Forms("入庫(kù)單查詢").數(shù)據(jù)表子窗體.Requery
End Sub
?
?
?
Private Sub Form_Load()
Me.金額 = Nz(DLookup("金額", "入庫(kù)單金額查詢", "入庫(kù)單號(hào)='" & Me.入庫(kù)單號(hào) & "'"), 0)
End Sub
?
入庫(kù)單添加
Option Compare Database
Option Explicit
?
Private Sub Command導(dǎo)入_Click()
On Error GoTo inputerror
Dim upfilename As String
Dim dlgOpen As FileDialog
Set dlgOpen = Application.FileDialog(msoFileDialogFilePicker)
With dlgOpen
.AllowMultiSelect = False
.Filters.Add "Excel", "*.xlsx; *.xlsm", 1
???? If .Show = -1 Then
??????? upfilename = .SelectedItems(1)
???? Else
??????? Exit Sub
???? End If
End With
?
'------------------------------------------------清空表數(shù)據(jù)
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 本地入庫(kù)單表"
DoCmd.RunSQL del_sql
'------------------------------------------
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("本地入庫(kù)單表", dbOpenTable)
'打開(kāi)創(chuàng)建的表并處理數(shù)據(jù)
Dim excelopenpathname As String
excelopenpathname = upfilename???? '復(fù)制粘貼新Excel文件的路徑和名稱
'處理打開(kāi)的表數(shù)據(jù)
Dim xlapp As excel.Application
Dim xlwbk As excel.Workbook
Dim xlwsh As excel.Worksheet
Set xlapp = New excel.Application
Dim CreateExcel As Object
Set CreateExcel = xlapp
xlapp.Visible = True
Set xlwbk = xlapp.WorkBooks.Open(excelopenpathname)
xlwbk.Activate
Set xlwsh = xlwbk.Worksheets(1)
With xlwsh
??? Dim i
??? On Error Resume Next
??? '--------------------------------------------------處理過(guò)程
??? If .cells(2, 1).Value <> "" Then
??? Else
??? GoTo exitexcel
??? End If
??? For i = 2 To .Range("A1").End(xlDown).Row
??????? add_rs.AddNew
add_rs!入庫(kù)單號(hào).Value = .cells(i, 1).Value
add_rs!供貨單位.Value = .cells(i, 2).Value
add_rs!入庫(kù)類別.Value = .cells(i, 3).Value
add_rs!入庫(kù)日期.Value = .cells(i, 4).Value
add_rs!供貨人.Value = .cells(i, 5).Value
add_rs!經(jīng)辦人.Value = .cells(i, 6).Value
add_rs!備注.Value = .cells(i, 7).Value
?
??????? add_rs.Update
??? Next i
End With
exitexcel:
xlwbk.Save
xlwbk.Close
xlapp.Quit
?
'------------------------------------------
Me.數(shù)據(jù)表子窗體.Requery
Exit Sub
inputerror:
MsgBox Err.Description
End Sub
?
Private Sub Command清空_Click()
入庫(kù)單號(hào).Value = 生成入庫(kù)單號(hào)(Date)
供貨單位.Value = ""
入庫(kù)類別.Value = ""
入庫(kù)日期.Value = Date
供貨人.Value = ""
經(jīng)辦人.Value = ""
備注.Value = ""
?
End Sub
?
Private Sub Command上傳_Click()
On Error GoTo 上傳數(shù)據(jù)失敗錯(cuò)誤
?
If MsgBox("是否將數(shù)據(jù)添加至入庫(kù)單表，注意：重復(fù)的入庫(kù)單號(hào)將不會(huì)添加", vbOKCancel) <> vbOK Then
Exit Sub
End If
?
If Nz(DCount("入庫(kù)單號(hào)", "本地入庫(kù)單表"), 0) = 0 Then??? '上傳入庫(kù)單記錄數(shù)量
Exit Sub
End If
?
'---------------------------------------------------------------查詢前端
Dim search_rs As DAO.Recordset
Dim search_sql As String
search_sql = "Select * From 本地入庫(kù)單表"
Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset)
'---------------------------------------------------------------建立查詢
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("入庫(kù)單表", dbOpenTable)
'---------------------------------------------------------------
?
On Error Resume Next
Do While search_rs.EOF = False
?
add_rs.AddNew
?
add_rs!入庫(kù)單號(hào).Value = search_rs!入庫(kù)單號(hào).Value
add_rs!供貨單位.Value = search_rs!供貨單位.Value
add_rs!入庫(kù)類別.Value = search_rs!入庫(kù)類別.Value
add_rs!入庫(kù)日期.Value = search_rs!入庫(kù)日期.Value
add_rs!供貨人.Value = search_rs!供貨人.Value
add_rs!經(jīng)辦人.Value = search_rs!經(jīng)辦人.Value
add_rs!備注.Value = search_rs!備注.Value
?
?
add_rs.Update
?
search_rs.MoveNext
Loop
'---------------------------------------------------------------斷開(kāi)后端鏈接
?
add_rs.Close
Set add_rs = Nothing
?
'---------------------------------------------------------------斷開(kāi)前端鏈接
search_rs.Close
Set search_rs = Nothing
?
MsgBox "上傳數(shù)據(jù)完成"
Exit Sub
上傳數(shù)據(jù)失敗錯(cuò)誤:
MsgBox "上傳數(shù)據(jù)失敗！" & vbCrLf & Err.Description
?
End Sub
?
Private Sub Command添加_Click()
On Error GoTo 添加失敗錯(cuò)誤
?
If 入庫(kù)單號(hào) = "" Or IsNull(入庫(kù)單號(hào)) = True Then
MsgBox "入庫(kù)單號(hào)值為空！"
Exit Sub
End If
?
If 入庫(kù)日期 = "" Or IsNull(入庫(kù)日期) = True Then
MsgBox "入庫(kù)日期值為空！"
Exit Sub
End If
?
If Nz(DCount("入庫(kù)單號(hào)", "入庫(kù)單表", "入庫(kù)單號(hào)='" & Me.入庫(kù)單號(hào) & "'"), 0) > 0 Then
MsgBox "該入庫(kù)單號(hào)已存在！"
Exit Sub
End If
?
?
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("入庫(kù)單表", dbOpenTable)
add_rs.AddNew
'--------------------------------------------------------------字段賦值
On Error Resume Next
With add_rs
add_rs!入庫(kù)單號(hào).Value = 入庫(kù)單號(hào).Value
add_rs!供貨單位.Value = 供貨單位.Value
add_rs!入庫(kù)類別.Value = 入庫(kù)類別.Value
add_rs!入庫(kù)日期.Value = 入庫(kù)日期.Value
add_rs!供貨人.Value = 供貨人.Value
add_rs!經(jīng)辦人.Value = 經(jīng)辦人.Value
add_rs!備注.Value = 備注.Value
?
'add_rs!金額.Value = 金額.Value
?
?
End With
'----------------------------------------------------------
add_rs.Update
add_rs.Close
Set add_rs = Nothing
'----------------------------------------------------------
?
MsgBox "添加成功！"
Call Command清空_Click
?
Exit Sub
添加失敗錯(cuò)誤:
MsgBox Err.Description
End Sub
?
Private Sub Form_Close()
On Error Resume Next
rk_filter = ""
Forms("入庫(kù)單查詢").數(shù)據(jù)表子窗體.Requery
?
End Sub
?
Private Sub Form_Load()
DoCmd.Restore
Me.入庫(kù)日期 = Date
?
?
Me.入庫(kù)單號(hào) = 生成入庫(kù)單號(hào)(Date)
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 本地入庫(kù)單表"
DoCmd.RunSQL del_sql
Me.數(shù)據(jù)表子窗體.Requery
End Sub
?
?
?
?
?
Private Sub 入庫(kù)單號(hào)_DblClick(Cancel As Integer)
If Me.入庫(kù)日期 <> "" Then
Me.入庫(kù)單號(hào) = 生成入庫(kù)單號(hào)(Me.入庫(kù)日期)
Else
Me.入庫(kù)單號(hào) = 生成入庫(kù)單號(hào)(Date)
End If
End Sub
?
Private Sub 入庫(kù)日期_DblClick(Cancel As Integer)
Me.入庫(kù)日期 = Date
End Sub
?
?
?
Function 生成入庫(kù)單號(hào)(ByVal numdate As Date) As String
On Error GoTo 錯(cuò)誤
Dim search_num As String
?
search_num = "RK" & Format(numdate, "YYYYMMDD")
?
Dim num_count As Long
num_count = Nz(DCount("入庫(kù)單號(hào)", "入庫(kù)單表", "入庫(kù)單號(hào) like '*" & search_num & "*'"), 0) + 1
生成入庫(kù)單號(hào) = search_num & "" & Format(num_count, "000")
Exit Function
錯(cuò)誤:
生成入庫(kù)單號(hào) = ""
?
End Function
入庫(kù)類別數(shù)據(jù)表
Private Sub Form_BeforeUpdate(Cancel As Integer)
If gx_num = 0 Then
Exit Sub
End If
?
On Error GoTo 數(shù)據(jù)更新前提醒_Err
?
??? If (MsgBox("是否保存對(duì)記錄的修改", 1, "修改記錄提醒") = 1) Then
??????? Beep
'??????? MsgBox "記錄修改成功", vbyesOnly, "提醒"
??? Else
??????? DoCmd.RunCommand acCmdUndo
??? End If
?
?
數(shù)據(jù)更新前提醒_Exit:
'??? Exit Function
??? Exit Sub
?
數(shù)據(jù)更新前提醒_Err:
??? MsgBox Error$
??? Resume 數(shù)據(jù)更新前提醒_Exit
End Sub
入庫(kù)明細(xì)查詢數(shù)據(jù)表
Option Compare Database
?
Private Sub Form_AfterUpdate()
On Error Resume Next
Forms("入庫(kù)單管理").金額 = Nz(DLookup("金額", "入庫(kù)單金額查詢", "入庫(kù)單號(hào)='" & Forms("入庫(kù)單管理").入庫(kù)單號(hào) & "'"), 0)
End Sub
?
Private Sub Form_BeforeUpdate(Cancel As Integer)
If gx_num = 0 Then
Exit Sub
End If
?
On Error GoTo 數(shù)據(jù)更新前提醒_Err
?
??? If (MsgBox("是否保存對(duì)記錄的修改", 1, "修改記錄提醒") = 1) Then
??????? Beep
'??????? MsgBox "記錄修改成功", vbyesOnly, "提醒"
??????? Me.貨品編號(hào).Requery
??? Else
??? ????DoCmd.RunCommand acCmdUndo
??? End If
?
?
數(shù)據(jù)更新前提醒_Exit:
'??? Exit Function
??? Exit Sub
?
數(shù)據(jù)更新前提醒_Err:
??? MsgBox Error$
??? Resume 數(shù)據(jù)更新前提醒_Exit
End Sub
?
Private Sub Form_Timer()
?
If rkhp_num = 1 Then
?
??? If Me.貨品編號(hào) <> rkhp_text Then
???
??? Me.貨品編號(hào) = rkhp_text
??? Me.單價(jià) = Nz(DLookup("入庫(kù)價(jià)", "貨品表", "貨品編號(hào)='" & Me.貨品編號(hào) & "'"), 0)
??? End If
rkhp_num = 0
End If
End Sub
?
Private Sub 貨品編號(hào)_AfterUpdate()
Me.單價(jià) = Nz(DLookup("入庫(kù)價(jià)", "貨品表", "貨品編號(hào)='" & Me.貨品編號(hào) & "'"), 0)
End Sub
?
Private Sub 貨品編號(hào)_Change()
Me.單價(jià) = Nz(DLookup("入庫(kù)價(jià)", "貨品表", "貨品編號(hào)='" & Me.貨品編號(hào) & "'"), 0)
End Sub
?
Private Sub 貨品編號(hào)_DblClick(Cancel As Integer)
hp_type = 3
DoCmd.OpenForm "貨品選擇", acNormal
End Sub
系統(tǒng)主頁(yè)
Private Sub Command更新提醒_Click()
If gx_num = 1 Then
??? If MsgBox("是否關(guān)閉記錄更新時(shí)提醒", vbYesNo) = vbYes Then
??? gx_num = 0
??? End If
Exit Sub
End If
?
If gx_num = 0 Then
??? If MsgBox("是否打開(kāi)記錄更新時(shí)提醒", vbYesNo) = vbYes Then
??? gx_num = 1
??? End If
Exit Sub
End If
?
End Sub
?
Private Sub Command退出系統(tǒng)_Click()
If MsgBox("是否退出系統(tǒng)", vbYesNo) <> vbYes Then
Exit Sub
End If
Application.Quit acQuitSaveAll
End Sub
?
Private Sub Command系統(tǒng)后臺(tái)_Click()
DoCmd.Close acForm, Me.Name
DoCmd.SelectObject acForm, , True
End Sub
?
Private Sub Form_Load()
gx_num = 1
End Sub
?
?
公告函數(shù)變量（模塊）
Option Compare Database
?
?
'更新提醒
Public gx_num As Integer
?
'貨品
Public hp_filter As String????? '貨品篩選
Public hp_order As String????? '貨品排序
Public hp_num As String?? '貨品主鍵
?
'入庫(kù)
Public rk_filter As String????? '入庫(kù)篩選
Public rk_order As String????? '入庫(kù)排序
Public rk_num As String?? '入庫(kù)主鍵
?
?
'出庫(kù)
Public ck_filter As String????? '出庫(kù)篩選
Public ck_order As String????? '出庫(kù)排序
Public ck_num As String?? '出庫(kù)主鍵
?
'出入庫(kù)明細(xì)
Public crkmx_filter As String????? '出入庫(kù)明細(xì)篩選
Public crkmx_order As String????? '出入庫(kù)明細(xì)排序
?
'庫(kù)存統(tǒng)計(jì)
Public kc_filter As String????? '庫(kù)存篩選
Public kc_order As String????? '庫(kù)存排序
?
'出入庫(kù)查詢
Public crkcx_filter As String????? '出入庫(kù)查詢
Public crkcx_order As String????? '出入庫(kù)排序
?
?
'明細(xì)臺(tái)賬
Public mxtz_filter As String????? '出入庫(kù)查詢
Public mxtz_order As String????? '出入庫(kù)排序
?
Public mxtz_a1 As Integer
?
'選擇貨品
Public hp_type As Integer
?
?
'出庫(kù)明細(xì)貨品選擇
Public ckhp_text As String
Public ckhp_num As Integer
?
'入庫(kù)明細(xì)貨品選擇
Public rkhp_text As String
Public rkhp_num As Integer
?
?
Function IsFileExists(ByVal strFileName As String) As Boolean?? '判斷文件是否存在
? If Len(Dir(strFileName)) <> 0 Then
??? IsFileExists = True
? Else
??? IsFileExists = False
? End If
End Function
?
?
Public Sub 導(dǎo)出查詢表結(jié)果(ByVal tablename As String)
On Error GoTo 導(dǎo)出查詢_Err
?
??? DoCmd.OutputTo acOutputTable, tablename, "", "", False, "", , acExportQualityPrint
?
?
導(dǎo)出查詢_Exit:
??? Exit Sub
?
導(dǎo)出查詢_Err:
?
??? Resume 導(dǎo)出查詢_Exit
End Sub
?
Public Function rmb(s As Currency) As String??? '人民幣轉(zhuǎn)大寫
Dim s1, s2, l, x
??? s1 = LTrim(CStr(Abs(s)))
??? l = Len(s1)
??? Select Case l - InStrRev(s1, ".")
??? '雙引號(hào)內(nèi)是小數(shù)點(diǎn)
?????? Case l
???????? s2 = s1 + ".00"
?????? Case 1
???????? s2 = s1 + "0"
?????? Case 2
???????? s2 = s1
??? End Select
??? l = Len(s2)
??? Dim dx, c1, c2
??? dx = ""
??? c1 = "零壹貳叁肆伍陸柒捌玖"
??? c2 = "分角 元拾佰仟萬(wàn)拾佰仟億拾佰"
??? '角和元之間留一個(gè)空格
???? Do While l >= 1
???? x = Mid(s2, Len(s2) - l + 1, 1)
????
???
??? If x <> "." Then
??? dx = dx + Mid(c1, Val(x) + 1, 1) + Trim(Mid(c2, (l - 1) + 1, 1))
??? End If
???? l = l - 1
???? Loop
???? rmb = dx + "整"
End Function
?
