📄 frm_dt_djbh.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form Frm_dt_djbh
BorderStyle = 3 'Fixed Dialog
Caption = "输入单据编号"
ClientHeight = 3240
ClientLeft = 45
ClientTop = 330
ClientWidth = 6210
Icon = "Frm_dt_djbh.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3240
ScaleWidth = 6210
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame1
Caption = "地图下发"
Height = 1905
Left = 45
TabIndex = 2
Top = 90
Width = 6135
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 0
Left = 945
MaxLength = 4
TabIndex = 9
Text = "Text1"
Top = 225
Width = 510
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 1
Left = 1800
MaxLength = 4
TabIndex = 8
Text = "Text1"
Top = 225
Width = 510
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
DataField = "领取时间"
Height = 270
Index = 5
Left = 4455
Locked = -1 'True
TabIndex = 7
Top = 825
Width = 1395
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
DataField = "领取人"
Height = 270
Index = 3
Left = 5220
MaxLength = 5
TabIndex = 6
Top = 1395
Width = 810
End
Begin VB.ComboBox Combo1
Appearance = 0 'Flat
DataField = "领取单位"
Height = 300
Index = 3
ItemData = "Frm_dt_djbh.frx":2FD2
Left = 945
List = "Frm_dt_djbh.frx":2FD4
TabIndex = 5
Text = "Combo1"
Top = 810
Width = 2580
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
DataField = "批准人"
Height = 270
Index = 2
Left = 945
MaxLength = 5
TabIndex = 4
Top = 1395
Width = 810
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
DataField = "经办人"
Height = 270
Index = 4
Left = 3060
MaxLength = 5
TabIndex = 3
Top = 1395
Width = 810
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 315
Left = 5805
TabIndex = 10
Top = 810
Width = 240
_ExtentX = 423
_ExtentY = 556
_Version = 393216
CalendarForeColor= -2147483625
Format = 24641536
CurrentDate = 37630
End
Begin VB.Label label1
AutoSize = -1 'True
Caption = "单据编号:"
Height = 180
Index = 0
Left = 135
TabIndex = 19
Top = 315
Width = 810
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "(可输入以前的编号查询记录)"
ForeColor = &H00C00000&
Height = 180
Index = 0
Left = 2610
TabIndex = 18
Top = 405
Width = 2340
End
Begin VB.Label Label3
Caption = "-"
ForeColor = &H00000000&
Height = 150
Left = 1575
TabIndex = 17
Top = 315
Width = 150
End
Begin VB.Label Label4
AutoSize = -1 'True
ForeColor = &H00C00000&
Height = 180
Left = 2610
TabIndex = 16
Top = 180
Width = 90
End
Begin VB.Label label1
AutoSize = -1 'True
Caption = "经 办 人:"
Height = 180
Index = 8
Left = 2250
TabIndex = 15
Top = 1440
Width = 810
End
Begin VB.Label label1
AutoSize = -1 'True
Caption = "领 取 人:"
Height = 180
Index = 7
Left = 4380
TabIndex = 14
Top = 1440
Width = 810
End
Begin VB.Label label1
AutoSize = -1 'True
Caption = "领取单位:"
Height = 180
Index = 6
Left = 135
TabIndex = 13
Top = 870
Width = 810
End
Begin VB.Label label1
AutoSize = -1 'True
Caption = "批 准 人:"
Height = 180
Index = 4
Left = 135
TabIndex = 12
Top = 1440
Width = 810
End
Begin VB.Label label1
AutoSize = -1 'True
Caption = "领取时间:"
Height = 180
Index = 2
Left = 3645
TabIndex = 11
Top = 870
Width = 810
End
End
Begin VB.CommandButton Command2
Caption = "取消(&C)"
Height = 375
Left = 5130
TabIndex = 1
Top = 2070
Width = 1005
End
Begin VB.CommandButton Command1
Caption = "确定(&Y)"
Height = 375
Left = 3780
TabIndex = 0
Top = 2070
Width = 1005
End
End
Attribute VB_Name = "Frm_dt_djbh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim xxxX1 As String
Private Sub Command1_Click()
If Len(Text1(0).Text & "-" & Text1(1).Text) <> 9 Or Text1(1).Text = "0000" Then
MsgBox "输入的编号不符合规则,重新确认", vbExclamation, "提示"
Exit Sub
Else
'If xxxX1 = "" Or xxxX1 < Text1(0).Text & "-" & Text1(1).Text Then
For i = 2 To 5
If Text1(i) = "" Or Combo1(3).Text = "" Then
MsgBox "输入信息有误,重新输入"
Exit Sub
End If
Next i
Frm_dt_ff.pzr = Text1(2).Text
Frm_dt_ff.jbr = Text1(4).Text
Frm_dt_ff.ltr = Text1(3).Text
Frm_dt_ff.ltdw = Combo1(3).Text
Frm_dt_ff.ltsj = Text1(5).Text
'End If
Frm_dt_ff.djbh = Text1(0).Text & "-" & Text1(1).Text
Unload Me
Frm_dt_ff.Show vbModal
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub DTPicker1_Change()
aaa = DTPicker1.Value
Text1(5).Text = Year(aaa) & "年" & Month(aaa) & "月" & Day(aaa) & "日"
End Sub
Private Sub Form_Load()
Dim db As ADODB.Connection
Dim adoPrimaryRS As Recordset
Dim xx As String
xxxX1 = ""
Set db = New ADODB.Connection
db.CursorLocation = adUseClient
db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & fullpath("mdb\mapdata.lbl")
Set adoPrimaryRS = New Recordset
adoPrimaryRS.Open "select top 1 编号 from s_lqjl order by 编号 desc", db, adOpenStatic, adLockOptimistic
If adoPrimaryRS.RecordCount = 0 Then
X1 = "当前下发记录为空！"
Text1(0).Text = Year(Date)
Text1(1).Text = "0001"
Else
xxxX1 = adoPrimaryRS("编号")
X1 = "上一次单据编号为:" & adoPrimaryRS("编号")
Text1(0).Text = Left(adoPrimaryRS("编号"), 4)
xx = Format$("0000", Val(Right(X1, 4)) + 1)
x11 = Len(xx)
temp = ""
For i = 1 To 4 - x11
temp = temp & "0"
Next i
temp = temp & xx
Text1(1).Text = temp
End If
Label4.Caption = X1
format_txt1
Text1(4).Text = gz_user
Text1(2).Text = "肖卫东"
Text1(3).Text = "领图人"
DTPicker1.Value = Date
aaa = Date
Text1(5).Text = Year(aaa) & "年" & Month(aaa) & "月" & Day(aaa) & "日"
End Sub
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
If Index = 0 Or Index = 1 Then
strValid = "0123456789"
If KeyAscii > 26 Then
If InStr(strValid, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End If
End If
End Sub
Private Sub format_txt1()
On Error GoTo err_67:
Dim db1 As Connection
Dim adoPrimaryRS As Recordset
Set db1 = New Connection
db1.CursorLocation = adUseClient
db1.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & fullpath("mdb\mapdata.lbl")
Set adoPrimaryRS = New Recordset
adoPrimaryRS.Open "select 领图单位 from m_ltdw order by 领图单位", db1, adOpenStatic, adLockOptimistic
With adoPrimaryRS
For i = 0 To .RecordCount - 1
Combo1(3).AddItem adoPrimaryRS("领图单位"), i
.MoveNext
Next i
End With
adoPrimaryRS.Close
If Combo1(3).ListCount > 0 Then
Combo1(3).ListIndex = 0
End If
Exit Sub
err_67:
MsgBox Err.Description, vbExclamation
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -