📄 form_renwuv.frm
字号:
Caption = "人物档案代号"
Height = 180
Left = 2250
TabIndex = 41
Top = 3150
Width = 1080
End
Begin VB.Label Label16
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "全宗号"
Height = 180
Left = 570
TabIndex = 40
Top = 3180
Width = 540
End
Begin VB.Label Label14
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "主题词"
Height = 180
Left = 570
TabIndex = 39
Top = 4035
Width = 540
End
Begin VB.Label Label13
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "备注"
Height = 180
Left = 570
TabIndex = 38
Top = 4440
Width = 360
End
Begin VB.Label Label10
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "载体类型"
Height = 180
Left = 4170
TabIndex = 37
Top = 1890
Width = 720
End
Begin VB.Label Label8
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "数量(张)"
Height = 180
Left = 570
TabIndex = 36
Top = 2325
Width = 720
End
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "起始时间"
Height = 180
Left = 570
TabIndex = 35
Top = 1515
Width = 720
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "密级"
Height = 180
Left = 4470
TabIndex = 34
Top = 2790
Width = 360
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "题名"
ForeColor = &H000000C0&
Height = 180
Left = 570
TabIndex = 33
Top = 1095
Width = 360
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "室编档号"
ForeColor = &H000000C0&
Height = 180
Left = 570
TabIndex = 32
Top = 690
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
BeginProperty Font
Name = "隶书"
Size = 18
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 2160
TabIndex = 31
Top = 120
Width = 180
End
Begin VB.Label Label15
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "归档年份"
ForeColor = &H000000C0&
Height = 180
Left = 570
TabIndex = 30
Top = 1920
Width = 720
End
Begin VB.Label Label12
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "著录时间"
Height = 180
Left = 4155
TabIndex = 29
Top = 5460
Width = 720
End
Begin VB.Label Label11
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "著录者"
Height = 180
Left = 570
TabIndex = 28
Top = 5430
Width = 540
End
Begin VB.Label Label9
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "单位"
Height = 180
Left = 4470
TabIndex = 27
Top = 2370
Visible = 0 'False
Width = 360
End
Begin VB.Label Label7
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "终止时间"
Height = 180
Left = 4170
TabIndex = 26
Top = 1500
Width = 720
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "保管期限"
Height = 180
Left = 570
TabIndex = 25
Top = 2760
Width = 720
End
End
Attribute VB_Name = "form_RenWuV"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strfile As String
Private Sub Combo1_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub Combo2_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub Combo3_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub Combo4_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub Command1_Click()
On Error GoTo e:
If fand("T_ARCHIVE_0500_VOLUME", Text3.text) > 0 Then
If flag = "Insert" Then
MsgBox "室编档号重复,请核查!", vbExclamation, ""
Exit Sub
ElseIf Not (strfile = Text3.text) Then
MsgBox "室编档号重复,请核查!", vbExclamation, ""
Exit Sub
End If
End If
If DTPicker3.Value < DTPicker2.Value Then MsgBox "终止时间必须大于起始时间！", 48, "": Exit Sub
If Text3.text = "" Or Text3.text = " " Then
MsgBox "请输入室编档号！", vbExclamation, ""
Exit Sub
End If
If Text1.text = "" Or Text1.text = " " Then
MsgBox "请输入题名！", vbExclamation, ""
Exit Sub
End If
If Len(Text9.text) <> 4 Then
MsgBox "归档年份请输入4位!", 48, ""
Exit Sub
End If
'归档年分位数判断
If Me.DTPicker3.Value < Me.DTPicker2.Value Then
MsgBox "终止时间不应小于起始时间！", 48, ""
Exit Sub
End If
If flag = "Insert" Then
Dim sum As Integer
If Text5.text <> "" And Text6.text <> "" And Text7.text <> "" And Text12.text <> "" And Text13.text <> "" Then
strSql = "select count(*) from T_ARCHIVE_0500_VOLUME where FONDS_CODE='" & Text5.text & "' and CATALOG_CODE='" & Text6.text & "' and FILE_NUMBER='" & Text7.text & "' and sort_code='" & Text12.text & "' and series_code='" & Text13.text & "'"
'MsgBox strSql
rs.Open strSql, conn
sum = rs.Fields(0).Value
Debug.Print sum
rs.Close
If sum > 0 Then
MsgBox "档号重复,请核查!", vbExclamation, ""
Exit Sub
End If
End If '档号重复判断
num = id("T_ARCHIVE_0500_VOLUME")
strSql = "insert into T_ARCHIVE_0500_VOLUME ("
strSql = strSql + "RECORD_SEQUENCE_NUMBER,TITLE_PROPER,DISCRIPTOR,REFERENCE_CODE_OF_FILE_OFFICE"
strSql = strSql + ",DESCRIBING_DATE,MEDIUM_TYPE,PERSON_FOR_DESCRIPTION,FONDS_CODE"
strSql = strSql + ",CATALOG_CODE,FILE_NUMBER,ARCHIVE_YEAR,DATE_BEGUN"
strSql = strSql + ",DATE_FINISHED,SECRET_LEVEL_FOR_DOCUMENTS,RETENTION_PERIOD,MEDIUM_QUANTITY"
strSql = strSql + ",MEDIUM_UNIT,NOTES_OF_ARCHIVIST"
strSql = strSql + ",CLASS_CODE,flag"
strSql = strSql + ",SORT_CODE,SERIES_CODE,IS_SHARING"
strSql = strSql + ")values("
strSql = strSql + "" & num & ",'" & Text1.text & "','" & Text2.text & "','" & Text3.text & "' ,'" & Format(DTPicker1.Value, "yyyy-mm-dd") & "'"
strSql = strSql + ",'" & Combo4.text & "','" & Text8.text & "','" & Text5.text & "','" & Text6.text & "'"
strSql = strSql + ",'" & Text7.text & "','" & Text9.text & "','" & Format(DTPicker2.Value, "yyyy-mm-dd") & "','" & Format(DTPicker3.Value, "yyyy-mm-dd") & "'"
strSql = strSql + ",'" & Combo1.ListIndex & "' ,'" & Combo2.ListIndex & "' ," & Text10.text & ",'" & Combo3.text & "','" & Text11.text & "'"
strSql = strSql + ",'" & form_AnJuan.List1.ListIndex & "',0"
strSql = strSql + ",'" & Text12.text & "','" & Text13.text & "','" & Check1.Value & "'"
strSql = strSql + ")"
ElseIf flag = "Modify" Then
strSql = "update T_ARCHIVE_0500_VOLUME set "
strSql = strSql + "TITLE_PROPER ='" & Text1.text & "' ,DISCRIPTOR ='" & Text2.text & "' ,REFERENCE_CODE_OF_FILE_OFFICE ='" & Text3.text & "' ,DESCRIBING_DATE ='" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' "
strSql = strSql + ",MEDIUM_TYPE ='" & Combo4.text & "' ,PERSON_FOR_DESCRIPTION ='" & Text8.text & "' ,FONDS_CODE ='" & Text5.text & "' ,CATALOG_CODE ='" & Text6.text & "' "
strSql = strSql + ",FILE_NUMBER ='" & Text7.text & "' ,ARCHIVE_YEAR ='" & Text9.text & "' ,DATE_BEGUN ='" & Format(DTPicker2.Value, "yyyy-mm-dd") & "' ,DATE_FINISHED ='" & Format(DTPicker3.Value, "yyyy-mm-dd") & "' "
strSql = strSql + ",SECRET_LEVEL_FOR_DOCUMENTS ='" & Combo1.ListIndex & "' ,RETENTION_PERIOD ='" & Combo2.ListIndex & "' ,MEDIUM_QUANTITY =" & Text10.text & " ,MEDIUM_UNIT ='" & Combo3.text & "' ,NOTES_OF_ARCHIVIST ='" & Text11.text & "' "
strSql = strSql + ",SORT_CODE='" & Text12.text & "',SERIES_CODE='" & Text13.text & "',IS_SHARING='" & Check1.Value & "'"
strSql = strSql + " where RECORD_SEQUENCE_NUMBER=" & num & ""
For listI = 1 To ListView2.ListItems.Count
listSql = "update T_ARCHIVE_0500_FILE set REFERENCE_CODE_OF_FILE_OFFICE='" & Text3.text & "',FONDS_CODE='" & Text5.text & "',CATALOG_CODE='" & Text6.text & "',FILE_NUMBER='" & Text7.text & "',sort_code='" & Text12.text & "',series_code='" & Text13.text & "' where RECORD_SEQUENCE_NUMBER=" & ListView2.ListItems(listI).SubItems(1) & ""
rs.Open listSql, conn
Next listI
End If
'MsgBox strSql
rs.Open strSql, conn
MsgBox "保存成功！", vbInformation, ""
If flag = "Insert" Then
Dim itmX As ListItem
Set itmX = form_AnJuan.ListView1.ListItems.Add(, , form_AnJuan.ListView1.ListItems.Count + 1)
itmX.SubItems(1) = num
itmX.SubItems(2) = Text3.text
itmX.SubItems(3) = Text1.text
itmX.SubItems(4) = Format(DTPicker2.Value, "yyyy-mm-dd") + " " + Format(DTPicker3.Value, "yyyy-mm-dd")
itmX.SubItems(5) = Text10.text
End If
'If flag = "Modify" Then
form_AnJuan.Refresh
'End If
Exit Sub
e:
'MsgBox Err.Number & Err.Description, vbExclamation, ""
MsgBox "请输入正确数据格式", vbExclamation, ""
If rs.State = 1 Then
rs.Close
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
Dim i As Integer
If MsgBox("确实要移除吗？", vbYesNo + vbQuestion, "") = vbYes Then
rs.Open "update T_ARCHIVE_0500_FILE set flag=0,FONDS_CODE='',CATALOG_CODE='',FILE_NUMBER='',sort_code='',series_code='' where RECORD_SEQUENCE_NUMBER=" & ListView2.SelectedItem.SubItems(1) & ""
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -