📄 frmdatamodifymain.frm
字号:
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 21
Top = 480
Width = 1335
End
Begin VB.Label Label5
Caption = "单 位："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3600
TabIndex = 20
Top = 1800
Width = 1215
End
Begin VB.Label Label4
Caption = "颜 色："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 19
Top = 1710
Width = 1335
End
Begin VB.Label Label3
Caption = "规 格："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 18
Top = 1290
Width = 1335
End
Begin VB.Label Label2
Caption = "材料名称："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 17
Top = 885
Width = 1335
End
Begin VB.Label Label1
Caption = "助记码："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 4320
TabIndex = 16
Top = 840
Width = 855
End
Begin VB.Label Label9
Caption = "请输入材料代号："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 255
Left = 120
TabIndex = 15
Top = 120
Width = 1815
End
End
Attribute VB_Name = "frmdatamodifymain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private rs As ADODB.Recordset
Private i As Integer
Private str As String
Private Sub comadd_Click()
Me.MousePointer = 11
Unload Me
frmmaindata.Show 1
Me.MousePointer = 0
End Sub
Private Sub comcancel_Click()
If Trim(Me.ID) = "" Then
Exit Sub
End If
Set rs = New ADODB.Recordset
str = "SELECT stuffdatatable.id, stuffdatatable.helpcode, stuffdatatable.name, stuffdatatable.kind,stuffdatatable.color, stuffdatatable.unit, stuffclasstable.name AS stuffclass, libclasstable.memo as libclass, stuffdatatable.initlib, stuffdatatable.supply FROM stuffdatatable INNER JOIN stuffclasstable ON stuffdatatable.stuffclass = stuffclasstable.id INNER JOIN libclasstable ON stuffdatatable.libclass = libclasstable.name where stuffdatatable.id=" & Trim(Me.ID.Text)
rs.Open str, GetConnect, adOpenDynamic, adLockOptimistic
If rs.EOF And rs.BOF Then
MsgBox "无此记录资料！"
rs.Close
Exit Sub
Else
Me.helpcode.Enabled = True
Me.stuffname.Enabled = True
Me.kind.Enabled = True
Me.color.Enabled = True
Me.unit.Enabled = True
Me.stuffclass.Enabled = True
Me.libclass.Enabled = True
Me.initlib.Enabled = True
Me.supply.Enabled = True
Me.helpcode = Trim(rs![helpcode])
Me.stuffname = Trim(rs![Name])
Me.kind = Trim(rs![kind])
Me.color.Text = Trim(rs![color])
Me.unit = Trim(rs![unit])
Me.stuffclass.Text = Trim(rs![stuffclass])
Me.libclass.Text = Trim(rs![libclass])
Me.initlib = Trim(rs![initlib])
Me.supply.Text = Trim(rs![supply])
End If
rs.Close
Unload Me
End Sub
Private Sub comok_Click()
If Trim(Me.ID) = "" Then
Exit Sub
End If
Set rs = New ADODB.Recordset
str = "SELECT stuffdatatable.id, stuffdatatable.helpcode, stuffdatatable.name, stuffdatatable.kind,stuffdatatable.color, stuffdatatable.unit, stuffclasstable.name AS stuffclass, libclasstable.memo as libclass, stuffdatatable.initlib, stuffdatatable.supply FROM stuffdatatable INNER JOIN stuffclasstable ON stuffdatatable.stuffclass = stuffclasstable.id INNER JOIN libclasstable ON stuffdatatable.libclass = libclasstable.name where stuffdatatable.id=" & Trim(Me.ID.Text)
rs.Open str, GetConnect, adOpenDynamic, adLockOptimistic
If rs.EOF And rs.BOF Then
MsgBox "无此记录资料！"
rs.Close
Exit Sub
Else
Me.helpcode.Enabled = True
Me.stuffname.Enabled = True
Me.kind.Enabled = True
Me.color.Enabled = True
Me.unit.Enabled = True
Me.stuffclass.Enabled = True
Me.libclass.Enabled = True
Me.initlib.Enabled = True
Me.supply.Enabled = True
Me.helpcode = Trim(rs![helpcode])
Me.stuffname = Trim(rs![Name])
Me.kind = Trim(rs![kind])
Me.color.Text = Trim(rs![color])
Me.unit = Trim(rs![unit])
Me.stuffclass.Text = Trim(rs![stuffclass])
Me.libclass.Text = Trim(rs![libclass])
Me.initlib = Trim(rs![initlib])
Me.supply.Text = Trim(rs![supply])
End If
End Sub
Private Sub comsave_Click()
On Error Resume Next
If Trim(stuffname) = "" Or Trim(stuffclass.Text) = "" Or Trim(unit) = "" Or Trim(initlib) = "" Or Trim(libclass.Text) = "" Then
MsgBox "输入资料不完整！"
Exit Sub
End If
Set rs = New ADODB.Recordset
rs.Open "select * from stuffdatatable where stuffdatatable.id=" & Trim(Me.ID.Text), GetConnect, adOpenDynamic, adLockOptimistic
If rs.EOF And rs.BOF Then
MsgBox "ID有误！"
rs.Close
Exit Sub
End If
rs![helpcode] = Trim(Me.helpcode)
rs![Name] = Trim(stuffname)
rs![kind] = Trim(Me.kind)
rs![color] = Trim(Me.color.Text)
rs![unit] = Trim(Me.unit)
rs![stuffclass] = Mid(stuffclass.SelectedItem.Key, 2, 100)
rs![libclass] = Mid(libclass.SelectedItem.Key, 2, 100)
rs![initlib] = Trim(initlib)
rs![supply] = Trim(Me.supply.Text)
rs.Update
rs.Close
Me.helpcode.Enabled = False
Me.stuffname.Enabled = False
Me.kind.Enabled = False
Me.color.Enabled = False
Me.unit.Enabled = False
Me.stuffclass.Enabled = False
Me.libclass.Enabled = False
Me.initlib.Enabled = False
Me.supply.Enabled = False
'MsgBox "记录存盘OK!"
Unload Me
End Sub
Private Sub Form_Load()
Me.Top = 1800
Me.Left = 3000
Set rs = New ADODB.Recordset
rs.Open "select * from libclasstable ", GetConnect, adOpenStatic, adLockReadOnly
libclass.ComboItems.Clear
If rs.EOF And rs.BOF Then
MsgBox " 无资料 "
End If
For i = 1 To rs.RecordCount
libclass.ComboItems.Add , "_" & rs![Name], Trim(rs![memo])
rs.MoveNext
Next i
rs.Close
Set rs = New ADODB.Recordset
rs.Open "select * from stuffclasstable ", GetConnect, adOpenStatic, adLockReadOnly
stuffclass.ComboItems.Clear
If rs.EOF And rs.BOF Then
MsgBox "无资料！"
End If
For i = 1 To rs.RecordCount
stuffclass.ComboItems.Add , "_" & rs![ID], Trim(rs![Name])
rs.MoveNext
Next i
rs.Close
Set rs = New ADODB.Recordset
rs.Open "select distinct color from stuffdatatable where color <> ''", GetConnect, adOpenStatic, adLockReadOnly
color.Clear
If rs.EOF And rs.BOF Then
MsgBox "无资料！"
End If
For i = 1 To rs.RecordCount
color.AddItem Trim(rs![color])
rs.MoveNext
Next i
rs.Close
Set rs = New ADODB.Recordset
rs.Open "select distinct unit from stuffdatatable ", GetConnect, adOpenStatic, adLockReadOnly
unit.Clear
If rs.EOF And rs.BOF Then
MsgBox "无资料！"
End If
For i = 1 To rs.RecordCount
unit.AddItem Trim(rs![unit])
rs.MoveNext
Next i
rs.Close
Set rs = New ADODB.Recordset
rs.Open "select distinct supply from stuffdatatable where supply <> ''", GetConnect, adOpenStatic, adLockReadOnly
supply.Clear
If rs.EOF And rs.BOF Then
MsgBox "无资料！"
End If
For i = 1 To rs.RecordCount
supply.AddItem Trim(rs![supply])
rs.MoveNext
Next i
rs.Close
End Sub
Private Sub initlib_KeyPress(KeyAscii As Integer)
If (KeyAscii < 45 Or KeyAscii > 57) And KeyAscii <> 47 And KeyAscii <> 8 Then
KeyAscii = 0
End If
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error Resume Next
Dim idstr As String '取得当前记录号
Select Case Button.Key
Case "comfirst"
Set rs = New ADODB.Recordset
str = "SELECT stuffdatatable.id, stuffdatatable.helpcode, stuffdatatable.name, stuffdatatable.kind,stuffdatatable.color, stuffdatatable.unit, stuffclasstable.name AS stuffclass, libclasstable.memo as libclass, stuffdatatable.initlib, stuffdatatable.supply FROM stuffdatatable INNER JOIN stuffclasstable ON stuffdatatable.stuffclass = stuffclasstable.id INNER JOIN libclasstable ON stuffdatatable.libclass = libclasstable.name where stuffdatatable.stuffclass='" & pubidname & "' order by stuffdatatable.id"
rs.Open str, GetConnect, adOpenDynamic, adLockOptimistic
rs.MoveFirst
GetData
Case "compro"
If Trim(Me.ID.Text) = "" Then
Exit Sub
End If
idstr = "id=" & Trim(Me.ID.Text)
Set rs = New ADODB.Recordset
str = "SELECT stuffdatatable.id, stuffdatatable.helpcode, stuffdatatable.name, stuffdatatable.kind,stuffdatatable.color, stuffdatatable.unit, stuffclasstable.name AS stuffclass, libclasstable.memo as libclass, stuffdatatable.initlib, stuffdatatable.supply FROM stuffdatatable INNER JOIN stuffclasstable ON stuffdatatable.stuffclass = stuffclasstable.id INNER JOIN libclasstable ON stuffdatatable.libclass = libclasstable.name where stuffdatatable.stuffclass='" & pubidname & "' order by stuffdatatable.id"
rs.Open str, GetConnect, adOpenDynamic, adLockOptimistic
If rs.EOF And rs.BOF Then
rs.Close
Exit Sub
End If
rs.Find idstr '把记录定位在find 找到的记录上！
If rs.BOF Then
rs.MoveFirst
Else
rs.MovePrevious
End If
GetData
Case "comnext"
If Trim(Me.ID.Text) = "" Then
Exit Sub
End If
idstr = "id=" & Trim(Me.ID.Text)
Set rs = New ADODB.Recordset
str = "SELECT stuffdatatable.id, stuffdatatable.helpcode, stuffdatatable.name, stuffdatatable.kind,stuffdatatable.color, stuffdatatable.unit, stuffclasstable.name AS stuffclass, libclasstable.memo as libclass, stuffdatatable.initlib, stuffdatatable.supply FROM stuffdatatable INNER JOIN stuffclasstable ON stuffdatatable.stuffclass = stuffclasstable.id INNER JOIN libclasstable ON stuffdatatable.libclass = libclasstable.name where stuffdatatable.stuffclass='" & pubidname & "' order by stuffdatatable.id"
rs.Open str, GetConnect, adOpenDynamic, adLockOptimistic
If rs.EOF And rs.BOF Then
rs.Close
Exit Sub
End If
rs.Find idstr
If rs.EOF Then
rs.MoveLast
Else
rs.MoveNext
End If
GetData
Case "comlast"
Set rs = New ADODB.Recordset
str = "SELECT stuffdatatable.id, stuffdatatable.helpcode, stuffdatatable.name, stuffdatatable.kind,stuffdatatable.color, stuffdatatable.unit, stuffclasstable.name AS stuffclass, libclasstable.memo as libclass, stuffdatatable.initlib, stuffdatatable.supply FROM stuffdatatable INNER JOIN stuffclasstable ON stuffdatatable.stuffclass = stuffclasstable.id INNER JOIN libclasstable ON stuffdatatable.libclass = libclasstable.name where stuffdatatable.stuffclass='" & pubidname & "' order by stuffdatatable.id"
rs.Open str, GetConnect, adOpenDynamic, adLockOptimistic
rs.MoveLast
GetData
End Select
rs.Close
End Sub
Private Sub GetData() '从数据库中取数据
If rs.EOF Or rs.BOF Then
Else
Me.ID = Format(Trim(rs![ID]), "00000")
Me.helpcode = Trim(rs![helpcode])
Me.stuffname = Trim(rs![Name])
Me.kind = Trim(rs![kind])
Me.color.Text = Trim(rs![color])
Me.unit = Trim(rs![unit])
Me.stuffclass.Text = Trim(rs![stuffclass])
Me.libclass.Text = Trim(rs![libclass])
Me.initlib = Trim(rs![initlib])
Me.supply.Text = Trim(rs![supply])
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -