📄 form39.frm
字号:
End
Begin VB.Line Line9
X1 = 9000
X2 = 9000
Y1 = 2520
Y2 = 0
End
Begin VB.Line Line5
X1 = 120
X2 = 11880
Y1 = 1080
Y2 = 1080
End
Begin VB.Line Line3
X1 = 120
X2 = 11880
Y1 = 720
Y2 = 720
End
Begin VB.Line Line1
X1 = 120
X2 = 11880
Y1 = 360
Y2 = 360
End
Begin VB.Label Label1
BackColor = &H8000000B&
BackStyle = 0 'Transparent
Caption = "购图编号:"
ForeColor = &H00FF0000&
Height = 255
Left = 360
TabIndex = 18
Top = 120
Width = 975
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "购图单位:"
ForeColor = &H00FF0000&
Height = 255
Left = 360
TabIndex = 17
Top = 480
Width = 975
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "图号:"
ForeColor = &H00FF0000&
Height = 255
Left = 600
TabIndex = 16
Top = 1560
Width = 1095
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "地区类别:"
ForeColor = &H00FF0000&
Height = 375
Left = 360
TabIndex = 15
Top = 1920
Width = 975
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "全额:"
ForeColor = &H00FF0000&
Height = 255
Left = 600
TabIndex = 14
Top = 2280
Width = 975
End
Begin VB.Label Label6
BackStyle = 0 'Transparent
Caption = "购图用途:"
ForeColor = &H00FF0000&
Height = 255
Left = 4080
TabIndex = 13
Top = 120
Width = 975
End
Begin VB.Label Label12
BackStyle = 0 'Transparent
Caption = "购图日期:"
ForeColor = &H00FF0000&
Height = 255
Left = 4080
TabIndex = 12
Top = 480
Width = 1095
End
Begin VB.Label Label15
BackStyle = 0 'Transparent
Caption = "比例尺:"
ForeColor = &H00FF0000&
Height = 255
Left = 480
TabIndex = 11
Top = 1200
Width = 975
End
Begin VB.Line Line8
X1 = 1320
X2 = 1320
Y1 = 1080
Y2 = 0
End
Begin VB.Line Line12
X1 = 3600
X2 = 3600
Y1 = 1080
Y2 = 0
End
Begin VB.Line Line13
X1 = 3840
X2 = 3840
Y1 = 2520
Y2 = 0
End
Begin VB.Line Line14
X1 = 7200
X2 = 7200
Y1 = 1080
Y2 = 0
End
Begin VB.Line Line16
X1 = 11880
X2 = 11880
Y1 = 2520
Y2 = 0
End
End
Attribute VB_Name = "Form39"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim da, da1 As Date
Private Sub Command1_Click()
Dim i, j, m, n, o, p, r, s, t As Integer
For i = 1 To hrs.RecordCount
If hrs.Fields(0).Value = username Then
If hrs.Fields(56).Value = "1" Then
For m = 0 To 10
Text1(m).Enabled = True
Next
gzrs.CursorLocation = adUseClient
gzrs.Open "select * from 出图 order by 购图编号", gzconn, adOpenKeyset, adLockPessimistic
If Form39.Text1(0).Text = "" Then
ln = MsgBox("购图编号不能为空,请重新输入!", vbInformation, "提示")
Form39.Text1(0).Text = ""
gzrs.Close
Exit Sub
End If
For r = 1 To gzrs.RecordCount
If Form39.Text1(0).Text = gzrs.Fields(0).Value Then
ln = MsgBox("图号已存在,请重新输入!", vbInformation, "提示")
gzrs.Close
Exit Sub
End If
gzrs.MoveNext
Next
For n = 0 To 19
If Form39.Text1(n).Text = "" Then
gg(n) = "0"
Else
gg(n) = Form39.Text1(n).Text
End If
Next
With gzrs
.AddNew
For r = 0 To 19
.Fields(r) = gg(r)
Next
End With
gzrs.Update
gzrs.Close
MsgBox "数据存储完毕!", vbInformation, "存储数据"
Exit For
End If
End If
hrs.MoveNext
Next
Form39.ListView1.ListItems.Clear
gzrs.CursorLocation = adUseClient
gzrs.Open "select * from 出图 order by 购图编号", gzconn, adOpenKeyset, adLockPessimistic
For o = 1 To gzrs.RecordCount
Form39.ListView1.ListItems.Add , , gzrs.Fields(0).Value
For p = 1 To 19
Form39.ListView1.ListItems.Item(o).SubItems(p) = gzrs.Fields(p).Value
Next
gzrs.MoveNext
Next
gzrs.Close
Form39.ListView1.ListItems(Form39.ListView1.ListItems.Count).Selected = True
Form39.ListView1.SelectedItem.EnsureVisible
Form39.ListView1.Refresh
For q = 0 To 10
Form39.Text1(q).Text = ""
Next
da1 = Date
Text1(8).Text = da1
Text1(9).Text = username
End Sub
Private Sub Command10_Click()
For i = 1 To Form39.ListView1.ListItems.Count
Form39.ListView1.ListItems.Item(i).Checked = False
Next
Unload Me
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
For i = 1 To Form40.ListView1.ListItems.Count
Form40.ListView1.ListItems.Item(i).Checked = False
Next
Unload Me
End Sub
Private Sub Command4_Click()
Dim i, j, k As Integer
Dim da, da1 As String
Static l As Integer
l = 0
gzrs.CursorLocation = adUseClient
gzrs.Open "出图", gzconn, adOpenKeyset, adLockPessimistic
For i = 1 To gzrs.RecordCount
If Text1(0).Text = gzrs.Fields(0).Value And gzrs.Fields(11).Value = "0" Then
l = l + 1
With gzrs
For k = 0 To 19
If Text1(k).Text = "" Then
.Fields(k).Value = "0"
Else
.Fields(k).Value = Text1(k).Text
End If
Next
End With
End If
gzrs.MoveNext
Next
gzrs.Close
If l <> 0 Then
MsgBox "数据修改完毕!", vbInformation, "存储数据"
Else
MsgBox "审批人已经审批过,无权进行修改!", vbInformation, "提示"
End If
For i = 1 To Form42.ListView1.ListItems.Count
Form42.ListView1.ListItems.Item(i).Checked = False
Next
Unload Me
End Sub
Private Sub Command5_Click()
For i = 1 To Form42.ListView1.ListItems.Count
Form42.ListView1.ListItems.Item(i).Checked = False
Next
Unload Me
End Sub
Private Sub Command6_Click()
Dim a, b, j As Integer
Dim ln As Long
gzrs.CursorLocation = adUseClient '审批人急需
gzrs.Open "出图", gzconn, adOpenKeyset, adLockPessimistic
For j = 1 To gzrs.RecordCount
If gzrs.Fields(0).Value = Form39.Text1(0).Text Then
If lty13 = "4" Or lty13 = "5" Then
If Text1(11).Text = "" Then
a11 = 0
Else
a11 = Text1(11).Text
End If
If Text1(12).Text = "" Then
a12 = 0
Else
a12 = Text1(12).Text
End If
With gzrs
.Fields(11) = a11
.Fields(12) = a12
End With
ln = MsgBox("审批人信息增加完成!", vbInformation, "提示")
End If
If lty13 = "6" Or lty13 = "7" Then
If Text1(13).Text = "" Then
a13 = 0
Else
a13 = Text1(13).Text
End If
If Text1(14).Text = "" Then
a14 = 0
Else
a14 = Text1(14).Text
End If
If Text1(15).Text = "" Then
a15 = 0
Else
a15 = Text1(15).Text
End If
With gzrs
.Fields(13) = a13
.Fields(14) = a14
.Fields(15) = a15
End With
ln = MsgBox("财务部信息增加完成!", vbInformation, "提示")
End If
If lty13 = "8" Or lty13 = "9" Then
If Text1(16).Text = "" Then
a16 = 0
Else
a16 = Text1(16).Text
End If
If Text1(17).Text = "" Then
a17 = 0
Else
a17 = Text1(17).Text
End If
With gzrs
.Fields(16) = a16
.Fields(17) = a17
End With
ln = MsgBox("出图部门信息增加完成!", vbInformation, "提示")
End If
If lty13 = "10" Or lty13 = "11" Then
If Text1(18).Text = "" Then
a18 = 0
Else
a18 = Text1(18).Text
End If
If Text1(19).Text = "" Then
a19 = 0
Else
a19 = Text1(19).Text
End If
With gzrs
.Fields(18) = a18
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -