📄 frmaddnew.frm
字号:
ColumnWidth = 689.953
EndProperty
BeginProperty Column08
ColumnWidth = 524.976
EndProperty
BeginProperty Column09
ColumnWidth = 734.74
EndProperty
BeginProperty Column10
ColumnWidth = 659.906
EndProperty
BeginProperty Column11
ColumnWidth = 390.047
EndProperty
BeginProperty Column12
ColumnWidth = 615.118
EndProperty
BeginProperty Column13
ColumnWidth = 870.236
EndProperty
BeginProperty Column14
ColumnWidth = 750.047
EndProperty
EndProperty
End
Begin MSAdodcLib.Adodc Adodc2
Height = 495
Left = 2520
Top = 3600
Visible = 0 'False
Width = 1455
_ExtentX = 2566
_ExtentY = 873
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 1
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=tsgl"
OLEDBString = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=tsgl"
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = "select * from newtb"
Caption = "Adodc2"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin MSAdodcLib.Adodc Adodc1
Height = 495
Left = 2520
Top = 4080
Visible = 0 'False
Width = 1455
_ExtentX = 2566
_ExtentY = 873
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 1
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=tsgl"
OLEDBString = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=tsgl"
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = "select * from lbtb"
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
End
Attribute VB_Name = "frmaddnew"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs1 As New ADODB.Recordset
Private Sub combo1_Click()
Adodc1.RecordSource = "select * from lbtb where 书籍类别='" & Trim(Combo1.Text) & "'"
Adodc1.Refresh
If Adodc1.Recordset.RecordCount > 0 Then
Text4.Text = Adodc1.Recordset.Fields(0)
Text12.Text = Adodc1.Recordset.Fields(2)
End If
End Sub
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Text4.SetFocus
End Sub
Private Sub Command1_Click()
If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Or Text4.Text = "" Or Text5.Text = "" Or Text6.Text = "" Or Text7.Text = "" Or Text8.Text = "" Or Text9.Text = "" Or Text10.Text = "" Or Text11.Text = "" Or Text12.Text = "" Then
MsgBox "输入的信息不能为空!", , "提示提示"
Else
Adodc2.RecordSource = "select * from newtb where 条码号='" & Text11.Text & "'"
Adodc2.Refresh
If Adodc2.Recordset.RecordCount > 0 Then
MsgBox "此条码号已经存在!", , "信息提示"
Adodc2.RecordSource = "select * from newtb"
Adodc2.Refresh
Else
rs1.Open "select * from newtb where 订单号='" & Text1.Text & "'", cnn, adOpenKeyset, adLockOptimistic
If rs1.RecordCount > 0 Then
MsgBox "订单号已存在!", , "提示信息"
Else
Dim sql, temp As String
temp = "0"
sql = "insert into newtb values('" & Text1 & "','" & DT1 & "','" & Text2 & "','" & Text3 & "','" & Text4 & "','" & Text5 & "','" & DT2 & "','" & Text6 & "','" & Text7 & "'," & Text8.Text & ",'" & Text9 & "','" & Text10 & "','" & Text11 & "','" & Text12 & "','" & Text13 & "','" & temp & "')"
cnn.Execute (sql)
MsgBox "数据保存成功!", 64, "提示信息"
Adodc2.Refresh
End If
rs1.Close
End If
End If
End Sub
Private Sub Command2_Click()
clear
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Command4_Click()
If Adodc2.Recordset.EOF = False Then
c = MsgBox("您确认要删除该记录吗?", 17, "提示信息")
If c = vbOK Then
Adodc2.Recordset.Delete
Adodc2.Refresh
Else
End If
Else
MsgBox "当前数据库中已经没有可删除的记录", 64, "提示信息"
End If
End Sub
Private Sub Command5_Click()
clear
Dim temp1
temp1 = Format(Now, "yyyymmdd")
Adodc2.RecordSource = "select * from newtb where 订单号 like '%" + temp1 + "%' order by 订单号"
Adodc2.Refresh
If Adodc2.Recordset.RecordCount > 0 Then
Adodc2.Recordset.MoveLast
Text1.Text = Val(Adodc2.Recordset.Fields("订单号")) + 1
Else
Text1.Text = temp1 + "0001"
End If
Adodc2.RecordSource = "select * from newtb where 是否验收=0 order by 订单号"
Adodc2.Refresh
DT1.SetFocus
End Sub
Private Sub DTPicker1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Text2.SetFocus
End Sub
Private Sub DT1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Text2.SetFocus
Else
End If
End Sub
Private Sub DTPicker2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Text6.SetFocus
End Sub
Private Sub DT2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then Text6.SetFocus
End Sub
Private Sub Form_Activate()
Dim temp1
temp1 = Format(Now, "yyyymmdd")
Adodc2.RecordSource = "select * from newtb where 订单号 like '%" + temp1 + "%' order by 订单号"
Adodc2.Refresh
If Adodc2.Recordset.RecordCount > 0 Then
Adodc2.Recordset.MoveLast
Text1.Text = Val(Adodc2.Recordset.Fields("订单号")) + 1
Else
Text1.Text = temp1 + "0001"
End If
Adodc2.RecordSource = "select * from newtb where 是否验收=0 order by 订单号"
Adodc2.Refresh
clear
End Sub
Private Sub Form_Load()
Me.Caption = Me.Caption & " " & frmmain.StatusBar1.Panels(2).Text
rs1.Open "lbtb", cnn, adOpenStatic, adLockOptimistic, adCmdTable
If rs1.RecordCount > 0 Then
rs1.MoveFirst
Do While rs1.EOF = False
Combo1.AddItem rs1.Fields("书籍类别")
rs1.MoveNext
If rs1.EOF Then Exit Do
Loop
End If
rs1.Close
clear
DT1.Value = Date
End Sub
Sub clear()
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
Text11.Text = ""
Text12.Text = ""
Text13.Text = ""
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then DTPicker1.SetFocus
End Sub
Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Text3.SetFocus
End Sub
Private Sub Text3_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Combo1.SetFocus
End Sub
Private Sub Text3_LostFocus()
If Not IsNumeric(Text3.Text) Then
Exit Sub
Else
MsgBox "书籍名称不能为数字", , "信息提示"
Text3.Text = ""
Text3.SetFocus
End If
End Sub
Private Sub Text4_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Text5.SetFocus
End Sub
Private Sub text5_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then DT2.SetFocus
End Sub
Private Sub Text6_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Text7.SetFocus
End Sub
Private Sub Text7_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Text8.SetFocus
End Sub
Private Sub Text8_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Text9.SetFocus
End Sub
Private Sub Text9_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Text10.SetFocus
End Sub
Private Sub Text10_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Text11.SetFocus
End Sub
Private Sub Text11_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Text12.SetFocus
End Sub
Private Sub Text12_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Text13.SetFocus
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -