📄 frm_jcxx_wlxx.frm
字号:
ButtonHeight = 1191
Appearance = 1
Style = 1
ImageList = "ImageList1"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 9
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = " 增加 "
Key = "add"
ImageIndex = 1
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "修改"
Key = "modify"
ImageIndex = 2
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "删除"
Key = "delete"
ImageIndex = 3
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "保存"
Key = "save"
ImageIndex = 4
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "取消"
Key = "cancel"
ImageIndex = 5
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "查找"
Key = "find"
ImageIndex = 6
EndProperty
BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
Enabled = 0 'False
EndProperty
BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
Enabled = 0 'False
Style = 3
EndProperty
BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "关闭"
Key = "close"
ImageIndex = 7
EndProperty
EndProperty
BorderStyle = 1
End
End
Attribute VB_Name = "Frm_Jcxx_Wlxx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs1 As New ADODB.Recordset
Public blnAdd As Boolean
Dim mybookmark
Dim Mystr As String '定义字符串变量
Dim Myrs As New ADODB.Recordset
Sub view_data() '显示数据信息
On Error Resume Next
Dim i As Integer
If Adodc1.Recordset.RecordCount > 0 Then
For i = 0 To 3
Text1(i).Text = Dgr_Wlxx.Columns(i)
Next i
Cbx_Cpbh.Text = Adodc1.Recordset.Fields("wlxx_cpbh")
Text1(4).Text = Adodc1.Recordset.Fields("wlxx_cpmc")
Text1(5).Text = Adodc1.Recordset.Fields("wlxx_cpgg")
Text1(6).Text = Adodc1.Recordset.Fields("wlxx_bz")
Text1(7).Text = Adodc1.Recordset.Fields("wlxx_wlsl")
End If
End Sub
Private Sub Cbx_Cpbh_Click()
Dim rs3 As New ADODB.Recordset
rs3.Open "select * from tb_SCGL_cpxx where cpxx_id='" + Cbx_Cpbh.Text + "'", cnn, adOpenKeyset
If rs3.RecordCount > 0 Then
Text1(4).Text = rs3.Fields("cpxx_cpmc")
Text1(5).Text = rs3.Fields("cpxx_cpgg")
End If
rs3.Close
End Sub
Private Sub Cbx_Cpbh_GotFocus()
Cbx_Cpbh.BackColor = &HFFFF80
End Sub
Private Sub Cbx_Cpbh_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then Text1(4).SetFocus
End Sub
Private Sub Cbx_Cpbh_LostFocus()
Cbx_Cpbh.BackColor = &HFFFFFF
Myrs.Open "select * from tb_SCGL_cpxx where cpxx_id= '" + Cbx_Cpbh.Text + "'", cnn, adOpenKeyset
If Myrs.RecordCount <= 0 Then
MsgBox "请输入正确的产品编号", , "信息提示"
Cbx_Cpbh.ListIndex = 0
Cbx_Cpbh.SetFocus
Myrs.Close
Exit Sub
End If
Myrs.Close
End Sub
Private Sub Dgr_Wlxx_Click()
view_data
End Sub
Private Sub Form_Load()
Adodc1.ConnectionString = PublicStr
'设置控件状态
For i = 0 To Text1.UBound
Text1(i).Enabled = False
Next i
Cbx_Cpbh.Enabled = False
'向Cbx_Cpbh中添加项目
Dim rs2 As New ADODB.Recordset
rs2.Open "select * from tb_SCGL_cpxx ", cnn, adOpenKeyset
If rs2.RecordCount > 0 Then
For i = 0 To rs2.RecordCount - 1
Cbx_Cpbh.AddItem rs2.Fields("cpxx_id")
rs2.MoveNext
Next i
End If
Cbx_Cpbh.ListIndex = 0
'设置Text1（4）中的内容
If Cbx_Cpbh.Text <> "" Then
Dim rs As New ADODB.Recordset
rs.Open "select * from tb_SCGL_cpxx where cpxx_id='" + Cbx_Cpbh.Text + "'", cnn, adOpenKeyset
If rs.RecordCount > 0 Then
Text1(4).Text = rs.Fields("cpxx_cpmc")
End If
Else
Text1(4).Text = ""
End If
'调用过程
Call Dgr_Title '调用过程
tlbState Toolbar1, False
Call view_data
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
sql = ""
End Sub
Sub Dgr_Title() '设置DataGrid控件的标题信息
Dgr_Wlxx.Columns(0).Caption = "物料编号"
Dgr_Wlxx.Columns(1).Caption = "物料名称"
Dgr_Wlxx.Columns(2).Caption = "物料规格"
Dgr_Wlxx.Columns(3).Caption = "计量单位"
Dgr_Wlxx.Columns(4).Caption = "产品编号"
Dgr_Wlxx.Columns(5).Caption = "产品名称"
Dgr_Wlxx.Columns(6).Caption = "产品规格"
Dgr_Wlxx.Columns(7).Caption = "备注信息"
Dgr_Wlxx.Columns(8).Caption = "物料需求量"
End Sub
Private Sub Text1_GotFocus(Index As Integer)
'Text1控件数组获得焦点
Text1(Index).BackColor = &HFFFF80
Text1(Index).SelStart = 0
Text1(Index).SelLength = Len(Text1(Index))
End Sub
Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
'Text1控件数据按回车键
If KeyCode = vbKeyReturn And Index < 7 Then
If Index = 3 Then
Cbx_Cpbh.SetFocus
Exit Sub
End If
If Index = 7 Then Exit Sub
Text1(Index + 1).SetFocus
End If
End Sub
Private Sub Text1_LostFocus(Index As Integer)
'Text1控件数据失去焦点
Text1(Index).BackColor = &HFFFFFF
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.key
Case "add" '添加
blnAdd = True '设置变量，如果为True，则在“保存”按钮中作插入操作
tlbState Toolbar1, True '调用模块中的过程
rs1.Open "select * from tb_SCGL_wlxx order by wlxx_id", cnn, adOpenStatic '打开数据集连接
If rs1.RecordCount > 0 Then '如果数据记录大于零
rs1.MoveLast '移至最后一条记录
Text1(0) = "WL" + Format(Val(Right(Trim(rs1.Fields("wlxx_id")), 3)) + 1, "###000") '编号自动加1
Else '如果没有记录
Text1(0) = "WL001"
End If
rs1.Close '关于数据对象
For i = 1 To Text1.UBound
Text1(i) = ""
Text1(i).Locked = False
Next i
Cbx_Cpbh.Locked = False
For i = 1 To Text1.UBound
Text1(i).Enabled = True
Next i
Cbx_Cpbh.Enabled = True
Text1(1).SetFocus
Case "modify" '修改
If Adodc1.Recordset.RecordCount > 0 Then
blnAdd = False '设置变量，如果为False，则在“保存”按钮中作修改操作
tlbState Toolbar1, True '调用模块中的过程
For i = 1 To Text1.UBound
Text1(i).Locked = False
Next i
Cbx_Cpbh.Locked = False
view_data '调用自定义的过程
mybookmark = Dgr_Wlxx.Bookmark
For i = 1 To Text1.UBound
Text1(i).Enabled = True
Next i
Cbx_Cpbh.Enabled = True
Else
MsgBox "系统没有要修改的数据！", , "提示窗口"
End If
Case "delete" '删除
If Adodc1.Recordset.RecordCount > 0 Then
'查询其他表中是否有相关的信息正在使用，如果有这不能删除该信息
Dim rs2 As New ADODB.Recordset
rs2.Open "select * from tb_SCGL_wlxq where wlxq_wlbh='" + Adodc1.Recordset.Fields("wlxx_id") + "'", cnn, adOpenKeyset
If rs2.RecordCount > 0 Then
MsgBox "该信息正在使用，不能删除！", , "信息提示"
Exit Sub
Else
Adodc1.Recordset.Delete
Adodc1.Refresh
For i = 0 To Text1.UBound
Text1(i).Text = ""
Next i
Cbx_Cpbh.Text = ""
Call view_data '调用数据显示自定义过程
Call Dgr_Title '调用设置表头的字定义过程
End If
Else
MsgBox "系统没有要删除的数据！", , "提示窗口"
End If
Case "save" '保存
''''' On Error GoTo SaveErr '错误处理
If Text1(1).Text = "" Then
MsgBox "系统不允许" & Label2 & "为空！", , "提示窗口"
Exit Sub
End If
If Text1(1).Text = "" Then
MsgBox "物料名称不能为空！", , "信息提示"
Text1(1).SetFocus
Exit Sub
End If
If Text1(2).Text = "" Then
MsgBox "物料规格不能为空！", , "信息提示"
Text1(2).SetFocus
Exit Sub
End If
If Text1(3).Text = "" Then
MsgBox "计量单位不能为空！", , "信息提示"
Text1(4).SetFocus
Exit Sub
End If
If Not IsNumeric(Text1(7).Text) Then
MsgBox "请输入正确的信息", , "信息提示"
Text1(7).Text = ""
Text1(7).SetFocus
Exit Sub
End If
If blnAdd = True Then '添加新记录
cnn.Execute ("insert into tb_SCGL_wlxx(wlxx_id,wlxx_wlmc,wlxx_wlgg,wlxx_wldw,wlxx_cpbh,wlxx_cpmc,wlxx_cpgg,wlxx_bz,wlxx_wlsl) values('" + Text1(0) + "','" + Text1(1) + "','" + Text1(2) + "','" + Text1(3) + "','" + Cbx_Cpbh.Text + "','" + Text1(4).Text + "','" + Text1(5).Text + "','" + Text1(6) + "','" + str(Text1(7)) + "')")
Adodc1.Refresh
Set Dgr_Wlxx.DataSource = Adodc1
Call Dgr_Title
tlbState Toolbar1, False
For i = 1 To Text1.UBound
Text1(i).Locked = True
Next i
Cbx_Cpbh.Locked = True
Else '修改原有记录
cnn.Execute ("update tb_SCGL_wlxx set wlxx_wlmc ='" + Text1(1) + "',wlxx_wlgg='" + Text1(2) + "',wlxx_wldw='" + Text1(3) + "',wlxx_cpbh='" + Cbx_Cpbh.Text + "',wlxx_cpmc='" + Text1(4) + "',wlxx_cpgg='" + Text1(5) + "',wlxx_bz='" + Text1(6) + "',wlxx_wlsl='" + Text1(7) + "' where wlxx_id='" + Text1(0).Text + "'")
Adodc1.Refresh
Set Dgr_Wlxx.DataSource = Adodc1
Call Dgr_Title
Dgr_Wlxx.Bookmark = mybookmark
tlbState Toolbar1, False '调用模块中的自定义过程
For i = 1 To Text1.UBound
Text1(i).Locked = True
Next i
Cbx_Cpbh.Locked = True
End If
Exit Sub
SaveErr: '出错处理程序
MsgBox Err.Description, , "信息提示"
Case "cancel" ' 取消
tlbState Toolbar1, False
For i = 1 To Text1.UBound
Text1(i).Locked = True
Next i
Cbx_Cpbh.Locked = True
Call view_data
Case "find" ' 查询
Mystr = InputBox("请输入要查询的物料信息编号", "物料信息查询", "WL001")
rs1.Open "select * from tb_SCGL_wlxx where wlxx_id ='" + Mystr + "'", cnn, adOpenKeyset
If rs1.RecordCount > 0 Then
For i = 0 To 3
If rs1.Fields(i) <> "" Then
Text1(i).Text = rs1.Fields(i)
Else
Text1(i).Text = ""
End If
Cbx_Cpbh.Text = ""
Next i
If rs1.Fields(4) <> "" Then
Cbx_Cpbh.Text = rs1.Fields(4)
Else
Cbx_Cpbh.Text = ""
End If
If rs1.Fields(5) <> "" Then Text1(4).Text = rs1.Fields(5) Else Text1(4).Text = ""
If rs1.Fields(6) <> "" Then Text1(5).Text = rs1.Fields(6) Else Text1(5).Text = ""
If rs1.Fields(7) <> "" Then Text1(6).Text = rs1.Fields(7) Else Text1(6).Text = ""
If rs1.Fields(8) <> "" Then Text1(7).Text = rs1.Fields(8) Else Text1(7).Text = ""
End If
rs1.Close
Case "close" '关闭
Unload Me
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -