📄 frm_specbill_addart.frm
字号:
Style = 5
Object.Width = 1764
MinWidth = 1764
TextSave = "13:44"
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 3528
MinWidth = 3528
Text = "操作员："
TextSave = "操作员："
EndProperty
BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 2
Object.Width = 1411
MinWidth = 1411
TextSave = "NUM"
EndProperty
BeginProperty Panel5 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 3
Enabled = 0 'False
Object.Width = 1411
MinWidth = 1411
TextSave = "Ins"
EndProperty
BeginProperty Panel6 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 1
Enabled = 0 'False
Object.Width = 1411
MinWidth = 1411
TextSave = "CAPS"
EndProperty
BeginProperty Panel7 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 9349
MinWidth = 9349
Text = "总记录数："
TextSave = "总记录数："
EndProperty
BeginProperty Panel8 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 14887
MinWidth = 14887
Text = "大连华录影音实业有限公司"
TextSave = "大连华录影音实业有限公司"
EndProperty
EndProperty
End
Begin MSComctlLib.TreeView Tvw_Customer
Height = 8535
Left = 120
TabIndex = 4
Top = 480
Width = 3255
_ExtentX = 5741
_ExtentY = 15055
_Version = 393217
LineStyle = 1
Style = 7
ImageList = "ImageList2"
Appearance = 1
End
Begin VB.Menu Mnu_Popup
Caption = "弹出式菜单"
Visible = 0 'False
Begin VB.Menu Mnu_Add
Caption = "添加到规格单"
End
Begin VB.Menu Mnu_View
Caption = "查看此条信息"
End
Begin VB.Menu Mnu_Find
Caption = "查找客户财产"
End
Begin VB.Menu Mnu_Exit
Caption = "退出节目添加"
End
End
End
Attribute VB_Name = "Frm_SpecBill_AddArt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Tree_Change()
On Error GoTo err
Dim node1, node2 As Node
Dim key As String
Dim text As String
Dim Record_Position As Integer
Record_Position = 0
Set Cn_Area = New ADODB.Connection
Cn_Area.Open Cs
Set Rs_Area = New ADODB.Recordset
Rs_Area.Open "select * from Area_Customer order by 地区编码,客户编码", Cn_Area, adOpenKeyset, adLockOptimistic, adCmdText
If Rs_Area.RecordCount > 0 Then
Rs_Area.MoveFirst
Do While Rs_Area.EOF = False
Record_Position = Record_Position + 1
If Record_Position = 1 Then
AreaCode = Trim(Rs_Area.Fields("地区编码"))
CustomerCode = Trim(Rs_Area.Fields("客户编码"))
key = Trim(Rs_Area.Fields("地区编码"))
text = "(" & Trim(Rs_Area.Fields("地区编码")) & ")" & Trim(Rs_Area.Fields("地区名称"))
Set node1 = Tvw_Customer.Nodes.Add(, , key, text, 1)
key = Trim(Rs_Area.Fields("客户编码"))
text = "(" & Trim(Rs_Area.Fields("客户编码")) & ")" & Trim(Rs_Area.Fields("客户名称"))
Set node2 = Tvw_Customer.Nodes.Add(node1.Index, tvwChild, key, text, 1)
Else
'同地区不同客户
If AreaCode = Trim(Rs_Area.Fields("地区编码")) And CustomerCode <> Trim(Rs_Area.Fields("客户编码")) Then
CustomerCode = Trim(Rs_Area.Fields("客户编码"))
key = Trim(Rs_Area.Fields("客户编码"))
text = "(" & Trim(Rs_Area.Fields("客户编码")) & ")" & Trim(Rs_Area.Fields("客户名称"))
Set node2 = Tvw_Customer.Nodes.Add(node2.Index, tvwLast, key, text, 1)
End If
'不同地区不同客户
If AreaCode <> Trim(Rs_Area.Fields("地区编码")) And CustomerCode <> Trim(Rs_Area.Fields("客户编码")) Then
AreaCode = Trim(Rs_Area.Fields("地区编码"))
CustomerCode = Trim(Rs_Area.Fields("客户编码"))
key = Trim(Rs_Area.Fields("地区编码"))
text = "(" & Trim(Rs_Area.Fields("地区编码")) & ")" & Trim(Rs_Area.Fields("地区名称"))
Set node1 = Tvw_Customer.Nodes.Add(, , key, text, 1)
key = Trim(Rs_Area.Fields("客户编码"))
text = "(" & Trim(Rs_Area.Fields("客户编码")) & ")" & Trim(Rs_Area.Fields("客户名称"))
Set node2 = Tvw_Customer.Nodes.Add(node1.Index, tvwChild, key, text, 1)
End If
End If
Rs_Area.MoveNext
Loop
Else
MsgBox "记录为空!"
End If
Rs_Area.Close
Cn_Area.Close
Exit Sub
err:
MsgBox err.Description, vbCritical
End Sub
Private Sub Form_Load()
On Error GoTo err
Me.StatusBar1.Panels(3).text = ("操作员： " + OperatorName)
Call Tree_Change
Set Cn_CR = New ADODB.Connection
Cn_CR.Open Cs
Set Rs_CR = New ADODB.Recordset
Rs_CR.Open "select * from Customer_Riches order by 节目名称,母盘号码", Cn_CR, adOpenKeyset, adLockOptimistic, adCmdText 'adOpenKeyset, adLockOptimistic, adCmdText
Set TDBGrid_CusRiches.DataSource = Rs_CR
Call DGrid_Width_Set(Frm_SpecBill_AddArt)
Me.StatusBar1.Panels(7).text = "记录总数： " & Str(Rs_CR.RecordCount)
Exit Sub
err:
MsgBox err.Description, vbCritical
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
AreaCustomer_Key = ""
AreaCustomer_Text = ""
If Rs_CR.State = 1 Then
Rs_CR.Close
Cn_CR.Close
End If
Set Rs_CR = Nothing
Set Cn_CR = Nothing
End Sub
Private Sub Mnu_Add_Click()
On Error GoTo err
If Len(AreaCustomer_Key) = 5 And Rs_CR.RecordCount <> 0 And Rs_CR.EOF = False And Rs_CR.BOF = False Then
Load Frm_SpecBill_AddArt_Affirm
Frm_SpecBill_AddArt_Affirm.Show vbModal
End If
Exit Sub
err:
MsgBox err.Description, vbCritical
End Sub
Private Sub Mnu_Exit_Click()
On Error Resume Next
Unload Me
End Sub
Private Sub Mnu_Find_Click()
On Error GoTo err
Load Frm_SpecBill_CusRiches_Find
Frm_SpecBill_CusRiches_Find.Show vbModal
Exit Sub
err:
MsgBox err.Description, vbCritical
End Sub
Private Sub Mnu_View_Click()
On Error GoTo err
Call TDBGrid_CusRiches_DblClick
Exit Sub
err:
MsgBox err.Description, vbCritical
End Sub
Private Sub TDBGrid_CusRiches_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo err
If Button And vbRightButton _
Then PopupMenu mnu_Popup
Exit Sub
err:
MsgBox err.Description, vbCritical
End Sub
Private Sub TDBGrid_CusRiches_DblClick()
On Error GoTo err
If Len(AreaCustomer_Key) = 5 And Rs_CR.RecordCount <> 0 And Rs_CR.EOF = False And Rs_CR.BOF = False Then
Load Frm_SpecBill_AddArt_View
Frm_SpecBill_AddArt_View.Show vbModal
End If
Exit Sub
err:
MsgBox err.Description, vbCritical
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error GoTo err
Select Case Button.Index
Case 4 '添加到规格单(Add)
Call Mnu_Add_Click
' Load Frm_SpecBill_AddArt_Affirm
' Frm_SpecBill_AddArt_Affirm.Show vbModal
Case 5 '查看此条信息(View)
Call TDBGrid_CusRiches_DblClick
Case 6 '查找客户财产(Find)
Call Mnu_Find_Click
' Load Frm_SpecBill_CusRiches_Find
' Frm_SpecBill_CusRiches_Find.Show vbModal
Case 7 '退出节目添加(Exit)
Unload Me
End Select
Exit Sub
err:
MsgBox err.Description, vbCritical
End Sub
Private Sub Tvw_Customer_Collapse(ByVal Node As MSComctlLib.Node)
On Error GoTo err
AreaCustomer_Key = ""
AreaCustomer_Text = ""
Exit Sub
err:
MsgBox err.Description, vbCritical
End Sub
Private Sub Tvw_Customer_Expand(ByVal Node As MSComctlLib.Node)
On Error GoTo err
AreaCustomer_Key = ""
AreaCustomer_Text = ""
Exit Sub
err:
MsgBox err.Description, vbCritical
End Sub
Private Sub Tvw_Customer_NodeClick(ByVal Node As MSComctlLib.Node)
On Error GoTo err
AreaCustomer_Key = Node.key
AreaCustomer_Text = Node.text
If Node.Image = 1 Then
Node.Image = 2
Else
Node.Image = 1
End If
If Rs_CR.State = 1 Then Rs_CR.Close
Rs_CR.Open "select * from Customer_Riches where 内编码 like '%'+ '" & Node.key & "'+'%'" & _
"order by 节目名称,母盘号码", Cn_CR, adOpenKeyset, adLockOptimistic, adCmdText
Me.TDBGrid_CusRiches.Close
Set TDBGrid_CusRiches.DataSource = Rs_CR
Call DGrid_Width_Set(Frm_SpecBill_AddArt)
Me.StatusBar1.Panels(7).text = "记录总数： " & Str(Rs_CR.RecordCount)
Exit Sub
err:
MsgBox err.Description, vbCritical
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -