📄 新建快递单.frm
字号:
Top = 2775
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "手机"
Height = 180
Index = 10
Left = 5700
TabIndex = 13
Top = 2452
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "电话"
Height = 180
Index = 9
Left = 3900
TabIndex = 12
Top = 2452
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "单位名称"
Height = 180
Index = 8
Left = 3870
TabIndex = 11
Top = 2130
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "详细地址"
Height = 180
Index = 7
Left = 3870
TabIndex = 10
Top = 1290
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "目的地"
Height = 180
Index = 6
Left = 5670
TabIndex = 9
Top = 930
Width = 540
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "收件人"
Height = 180
Index = 5
Left = 3900
TabIndex = 8
Top = 930
Width = 540
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "电话"
Height = 180
Index = 4
Left = 420
TabIndex = 7
Top = 2452
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "始发地"
Height = 180
Index = 3
Left = 2190
TabIndex = 6
Top = 930
Width = 540
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "单位名称"
Height = 180
Index = 2
Left = 420
TabIndex = 5
Top = 2130
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "详细地址"
Height = 180
Index = 1
Left = 420
TabIndex = 4
Top = 1290
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "发件人"
Height = 180
Index = 0
Left = 420
TabIndex = 3
Top = 930
Width = 540
End
Begin VB.Shape Shape1
Height = 195
Left = 8250
Top = 90
Width = 555
End
End
End
Attribute VB_Name = "xjkdd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs As ADODB.Recordset
Dim KH_ID As String
Private Sub Combo2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
sqltext = "select * from 客户资料 where 简称 like '" & Trim(Combo2.Text) & "%'"
Set rs = ExecuteSQL(sqltext, MsgString)
If Not (rs.EOF And rs.BOF) Then
Combo2.Text = rs(4)
End If
Text1.SetFocus
End If
End Sub
Private Sub Combo2_LostFocus()
If Combo2.Text <> "" Then
sqltext = "select * from 客户资料 where 单位名称='" & Combo2.Text & "'or 收件人='" & Combo2.Text & "'"
Set rs = ExecuteSQL(sqltext, MsgString)
If Not (rs.EOF And rs.BOF) Then
lbl_sjr.Caption = rs(1)
lbl_mdd.Caption = rs(2)
LBL_xxdzs.Caption = rs(3)
lbl_dh2.Caption = rs(5)
lbl_sj1.Caption = rs(6)
KH_ID = rs(0)
End If
End If
End Sub
Private Sub Form_Load()
'初始化设置
Call reset_combo
Call ShowCompany
End Sub
Private Sub Form_Resize()
Shape1.Move 30, 30, Me.Width - 60, Me.Height - 440
End Sub
Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image4.Move Image1.Left, Image1.Top
End Sub
Private Sub Image3_Click()
'取消
Unload Me
End Sub
Private Sub Image2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'切入图片
Image3.Move Image2.Left, Image2.Top
End Sub
Private Sub Image4_Click()
'确定
On Error Resume Next
Dim FJR_ID As String
If Text1 <> "" And Text2 <> "" And Text3 <> "" And Combo1.Text <> "" And Combo2.Text <> "" Then
sqltext = "select * from 发件人表 where 发件人姓名='" & Trim(Combo1.Text) & "'"
Set rs = ExecuteSQL(sqltext, MsgString)
If rs.EOF And rs.BOF Then
MsgBox "发件人姓名，末找到", vbCritical, "提示"
Combo1.SetFocus
Exit Sub
Else
FJR_ID = rs(0)
End If
If Check1.Value = 1 Then
lx = "物品"
Else
lx = "货样"
End If
If Check4.Value = 1 Then
fkfs = "月结"
Else
fkfs = "现金"
End If
sqltext = "insert into 快递表 values ('" & Text1 & "','" & lx & "','" & Text2 & "','" & Text3
sqltext = sqltext & "','" & fkfs & "','" & Text4 & "','" & KH_ID & "','" & FJR_ID & "','" & Now() & "')"
Set rs = ExecuteSQL(sqltext, MsgString)
'' sqltext = "delete from 打印表"
'' Set rs = ExecuteSQL(sqltext, MsgString)
''
'' sqltext = "insert into 打印表 values ('" & Text1 & "','" & lx & "','" & Text2 & "','" & Text3
'' sqltext = sqltext & "','" & fkfs & "','" & Text4 & "','" & Trim(Combo1.Text) & "','" & lbl_dwmf.Caption
'' sqltext = sqltext & "','" & lbl_xxdzF.Caption & "','" & lbl_sfd.Caption & "','" & lbl_dh1 & "','" & lbl_sjr
'' sqltext = sqltext & "','" & lbl_mdd.Caption & "','" & LBL_xxdzs.Caption & "','" & Trim(Combo2.Text)
'' sqltext = sqltext & "','" & lbl_dh2.Caption & "','" & lbl_sj1 & "')"
''
'' Set rs = ExecuteSQL(sqltext, MsgString)
sqltext = "insert into 待打印表 values ('" & Text1 & "','" & lx & "','" & Text2 & "','" & Text3
sqltext = sqltext & "','" & fkfs & "','" & Text4 & "','" & Trim(Combo1.Text) & "','" & lbl_dwmf.Caption
sqltext = sqltext & "','" & lbl_xxdzF.Caption & "','" & lbl_sfd.Caption & "','" & lbl_dh1 & "','" & lbl_sjr
sqltext = sqltext & "','" & lbl_mdd.Caption & "','" & LBL_xxdzs.Caption & "','" & Trim(Combo2.Text)
sqltext = sqltext & "','" & lbl_dh2.Caption & "','" & lbl_sj1 & "','" & "未完成" & "')"
Set rs = ExecuteSQL(sqltext, MsgString)
'显示是否需要打印
'' ret = MsgBox("速递单已经保存,是否需要打印?", vbInformation + vbYesNo, "打印提示")
''
'' If ret = vbYes Then '需要打印
'' dykdd.Show 1
'' Else
'' Unload Me
'' End If
'' sqltext = "insert into 打印表完成表 values ('" & Text1 & "','" & lx & "','" & Text2 & "','" & Text3
'' sqltext = sqltext & "','" & fkfs & "','" & Text4 & "','" & Trim(Combo1.Text) & "','" & lbl_dwmf.Caption
'' sqltext = sqltext & "','" & lbl_xxdzF.Caption & "','" & lbl_sfd.Caption & "','" & lbl_dh1 & "','" & lbl_sjr
'' sqltext = sqltext & "','" & lbl_mdd.Caption & "','" & LBL_xxdzs.Caption & "','" & Trim(Combo2.Text)
'' sqltext = sqltext & "','" & lbl_dh2.Caption & "','" & lbl_sj1 & "'已完成'" & "')"
'' Set rs = ExecuteSQL(sqltext, MsgString)
Call gskdgl.ShowTreeView
Unload Me
Else
MsgBox "重要资料不能为空", vbCritical, "错误提示"
Text1.SetFocus
End If
End Sub
Private Sub Image5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&
End If
End Sub
Private Sub Image6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'切入图片
Image7.Move Image6.Left, Image6.Top
End Sub
Private Sub Image7_Click()
Unload Me
End Sub
Private Sub Label1_Click(Index As Integer)
Select Case Index
Case 14
If Check2.Value = 0 Then
Check2.Value = 1
Else
Check2.Value = 0
End If
Case 15
If Check3.Value = 0 Then
Check3.Value = 1
Else
Check3.Value = 0
End If
Case 16
If Check4.Value = 0 Then
Check4.Value = 1
Else
Check4.Value = 0
End If
Case 13
If Check1.Value = 0 Then
Check1.Value = 1
Else
Check1.Value = 0
End If
End Select
End Sub
Private Sub Label2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&
End If
End Sub
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&
End If
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image7.Move -200, -2000
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image7.Move -200, -2000
Image4.Move -200, -2000
Image3.Move -2000, 2000
End Sub
Private Sub reset_combo() '初始化列表栏
On Error Resume Next
Combo1.Clear
sqltext = "select * from 发件人表"
Set rs = ExecuteSQL(sqltext, MsgString)
If Not (rs.EOF And rs.BOF) Then
Do
Combo1.AddItem rs(1)
rs.MoveNext
Loop Until rs.EOF
End If
Combo2.Clear
sqltext = "select * from 客户资料"
Set rs = ExecuteSQL(sqltext, MsgString)
If Not (rs.EOF And rs.BOF) Then
Do
If IsNull(rs(4)) Or rs(4) = "" Then
Combo2.AddItem rs(1)
Else
Combo2.AddItem rs(4)
End If
rs.MoveNext
Loop Until rs.EOF
End If
End Sub
Private Sub ShowCompany()
sqltext = "select * from 公司资料"
Set rs = ExecuteSQL(sqltext, MsgString)
If Not (rs.EOF And rs.BOF) Then
lbl_sfd.Caption = rs(2)
lbl_xxdzF.Caption = rs(1)
lbl_dwmf.Caption = rs(0)
lbl_dh1.Caption = rs(3)
End If
End Sub
Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
End Sub
Private Sub Text2_GotFocus()
Text2.SelStart = 0
Text2.SelLength = Len(Text2)
End Sub
Private Sub Text3_GotFocus()
Text3.SelStart = 0
Text3.SelLength = Len(Text3)
End Sub
Private Sub Text4_GotFocus()
Text4.SelStart = 0
Text4.SelLength = Len(Text4)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -