📄 form4.frm
字号:
Width = 1200
_ExtentX = 2117
_ExtentY = 582
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
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
Begin VB.CommandButton Command4
Caption = "保存"
Enabled = 0 'False
Height = 255
Left = 2256
TabIndex = 11
Top = 4320
Width = 655
End
Begin VB.TextBox Text3
Enabled = 0 'False
Height = 275
Left = 2520
TabIndex = 10
Top = 3600
Width = 1932
End
Begin VB.TextBox Text2
Enabled = 0 'False
Height = 275
Left = 2520
TabIndex = 9
Top = 2916
Width = 1932
End
Begin VB.TextBox Text1
Enabled = 0 'False
Height = 275
Left = 2520
TabIndex = 8
Top = 2244
Width = 1932
End
Begin VB.CommandButton Command3
Caption = "返回"
Height = 255
Left = 5280
TabIndex = 7
Top = 4320
Width = 655
End
Begin VB.CommandButton Command2
Caption = "修改"
Height = 255
Left = 3324
TabIndex = 6
Top = 4320
Width = 655
End
Begin VB.CommandButton Command1
Caption = "添加"
Height = 255
Left = 1200
TabIndex = 5
Top = 4320
Width = 655
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 252
Left = 2520
TabIndex = 3
Top = 1680
Width = 1932
_ExtentX = 3413
_ExtentY = 450
_Version = 393216
Format = 63963137
CurrentDate = 37953
End
Begin VB.Label Label7
Caption = "合同执行详情："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 252
Left = 6840
TabIndex = 39
Top = 1440
Width = 2532
End
Begin VB.Label Label6
Caption = "票号提示："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 492
Left = 4800
TabIndex = 15
Top = 1440
Width = 1572
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 = 252
Left = 1200
TabIndex = 4
Top = 1680
Width = 972
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 = 252
Left = 1200
TabIndex = 2
Top = 3600
Width = 1332
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 = 252
Left = 1200
TabIndex = 1
Top = 2964
Width = 1332
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 = 252
Left = 1200
TabIndex = 0
Top = 2316
Width = 1452
End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Data As ADODB.Connection
Dim ret As ADODB.Recordset
Dim xx As Boolean
Private Sub Command1_Click()
Dim hm As String
Dim recc As Integer
Adodc1.ConnectionString = connetstr
Adodc1.RecordSource = "select * from fyjh"
Adodc1.refresh
If Adodc1.Recordset.RecordCount > 0 Then
Adodc1.Recordset.MoveLast
hm = Trim(Adodc1.Recordset.Fields(1))
recc = Len(hm)
hm = Format(Mid(hm, 1, recc - 1), "0000000") & Trim(Str(Val(Right(hm, 1)) + 1))
Else
hm = Format(1, "0000000")
End If
Text1.Text = hm
Me.DTPicker1.Enabled = True
Me.Text1.Enabled = True
Me.Text2.Enabled = True
Me.Command1.Enabled = False
Me.Command4.Enabled = True
End Sub
Private Sub Command2_Click()
'Me.Height = 5880
Me.DataGrid1.AllowUpdate = True
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Command4_Click()
If Text2.Text = "" Then
MsgBox "发票号不能为空"
Exit Sub
End If
If Text3.Text = "" Then
MsgBox "发运计划量不能为空"
Exit Sub
End If
Call Text3_LostFocus
Adodc1.RecordSource = "select * from fyjh "
Adodc1.refresh
'If Adodc1.Recordset.RecordCount >= 1 Then
' MsgBox "该计划已安排"
' Exit Sub
'End If
' cn.Execute "insert into fyjh (jl_fahuohao,jl_fapiaohao,jl_jinrifan,jl_fayunshijian) VALUES (" & Trim(Text1.Text) & "," & Trim(Text2.Text) & " ," & Val(Text3.Text) & "," & Format(Me.DTPicker1.Value, "yyyy-mm-dd") & ")"
Adodc1.Recordset.AddNew
Adodc1.Recordset.Fields(1) = Trim(Text1.Text)
Adodc1.Recordset.Fields(2) = Trim(Text2.Text)
Adodc1.Recordset.Fields(3) = Val(Trim(Text3.Text))
Adodc1.Recordset.Fields(4) = Format(Me.DTPicker1.Value, "yyyy-mm-dd")
Adodc1.Recordset.UpdateBatch adAffectCurrent
'Adodc1.Recordset.Close
'Me.Height = 5880
Me.Command1.Enabled = True
Me.Command4.Enabled = False
Adodc2.refresh
'Adodc2.Recordset.MoveLast
End Sub
Private Sub Command5_Click()
xx = Not xx
If xx = True Then
' Me.Height = 4428
Me.Command5.Caption = "浏览>>"
Else
' Me.Height = 6800
Me.Command5.Caption = "<<浏览"
End If
End Sub
Private Sub Command6_Click()
htkk.Show
End Sub
Private Sub Command7_Click()
Me.Adodc2.Recordset.delete
End Sub
Private Sub DataGrid1_DblClick()
'Me.Height = 3660
jl_hth = Me.Adodc2.Recordset.Fields(1)
htkk.Show
End Sub
Private Sub Form_Load()
'On Error Resume Next
Me.DTPicker1.Value = Now
Me.Adodc1.ConnectionString = connetstr
Adodc1.RecordSource = "select * from htk where wfl>0 and djj=0 and dj>0 order by sj "
Adodc1.refresh
Me.Adodc2.ConnectionString = connetstr
Me.Adodc2.RecordSource = "select jl_fahuohao as 发货号,jl_fapiaohao as 发票号,jl_jinrifan AS 当日发运量, jl_fayunshijian AS 安排发运时间 from fyjh "
Me.Adodc2.refresh
Adodc1.Recordset.MoveFirst
Dim recc As Integer
recc = Adodc1.Recordset.RecordCount
Me.Label6.Caption = "发票号提示:(共" & recc & ")条:"
Dim ff As Integer
For ff = 1 To recc
Me.List1.AddItem Adodc1.Recordset.Fields(0)
' 'debug.Print Adodc1.Recordset.Fields(0), recc
Adodc1.Recordset.MoveNext
Next ff
Adodc2.ConnectionString = connetstr
xx = True
If Adodc2.Recordset.RecordCount > 1 Then
Adodc2.Recordset.MoveLast
End If
End Sub
Private Sub List1_Click()
Text2.Text = Me.List1.Text
Adodc1.RecordSource = "select * from htk where hth='" & Trim(Me.List1.Text) & "' order by sj "
Adodc1.refresh
Me.txtFields(0) = Adodc1.Recordset.Fields("hth")
Me.txtFields(1) = Adodc1.Recordset.Fields("htl")
Me.txtFields(2) = Adodc1.Recordset.Fields("yfl")
Me.txtFields(3) = Adodc1.Recordset.Fields("wfl")
Me.txtFields(4) = Adodc1.Recordset.Fields("hwm")
Me.txtFields(5) = Adodc1.Recordset.Fields("fhr")
Me.txtFields(7) = Adodc1.Recordset.Fields("jcje")
Me.txtFields(8) = Adodc1.Recordset.Fields("dj")
Me.txtFields(9) = Adodc1.Recordset.Fields("je")
Me.txtFields(10) = Adodc1.Recordset.Fields("sj")
End Sub
Private Sub text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Text2.SetFocus
End If
End Sub
Private Sub Text1_LostFocus()
Adodc1.RecordSource = "select * from fyjh where jl_fahuohao='" & Trim(Text1.Text) & "'"
Adodc1.refresh
If Adodc1.Recordset.RecordCount >= 1 Then
MsgBox "该号码已使用,请重输"
Adodc1.Recordset.Close
Exit Sub
End If
Adodc1.Recordset.Close
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Trim(Text2.Text) <= "" Then
Exit Sub
End If
Adodc1.RecordSource = "select * from htk where hth = '" & Trim(Text2.Text) & "'and wfl>0 order by hth"
Adodc1.refresh
If Adodc1.Recordset.RecordCount <= 0 And Text2.Text > "" Then
MsgBox "该票号不存在,请重输"
Adodc1.Recordset.Close
Text2.Text = ""
Text3.Enabled = False
Exit Sub
End If
jl_hth = Text2.Text
'htkk.Show
Text3.Enabled = True
Text3.SetFocus
End If
End Sub
Private Sub Text2_LostFocus()
If Trim(Text2.Text) <= "" Then
Exit Sub
End If
Adodc1.RecordSource = "select * from htk where hth = '" & Trim(Text2.Text) & "'and wfl>0 order by hth"
Adodc1.refresh
If Adodc1.Recordset.RecordCount <= 0 And Text2.Text > "" Then
MsgBox "该票号不存在,请重输"
Adodc1.Recordset.Close
Text2.Text = ""
Text3.Enabled = False
Exit Sub
End If
jl_hth = Text2.Text
''debug.Print jl_hth
'htkk.Show
Text3.Enabled = True
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Command4.Enabled = True
Command4.SetFocus
End If
End Sub
Private Sub Text3_LostFocus()
If jl_wfl - jl_jrfyl < 0 And Text2.Text > "" Then
MsgBox "本票号欠存量为 " & Str(jl_wfl) & " 公斤，" + Chr(10) + Chr(13) + "你安排的计划量超过欠存量，请重输!", vbCritical, "计划量超标"
Text3.Text = ""
Text3.SetFocus
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -