📄 form_wenshuv.frm
字号:
Caption = "著录者"
Height = 180
Left = 270
TabIndex = 26
Top = 5130
Width = 540
End
Begin VB.Label Label10
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "机构（问题）"
Height = 180
Left = 270
TabIndex = 25
Top = 3270
Width = 1080
End
Begin VB.Label Label9
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "总页数"
Height = 180
Left = 4350
TabIndex = 24
Top = 2370
Width = 540
End
Begin VB.Label Label8
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "总件数"
Height = 180
Left = 270
TabIndex = 23
Top = 2370
Width = 540
End
Begin VB.Label Label7
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "终止时间"
Height = 180
Left = 4170
TabIndex = 22
Top = 1530
Width = 720
End
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "起始时间"
Height = 180
Left = 270
TabIndex = 21
Top = 1500
Width = 720
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "保管期限"
Height = 180
Left = 270
TabIndex = 20
Top = 2820
Width = 720
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "密级"
Height = 180
Left = 4350
TabIndex = 19
Top = 2760
Width = 360
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "题名"
ForeColor = &H000000C0&
Height = 180
Left = 270
TabIndex = 18
Top = 1065
Width = 360
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "室编档号"
ForeColor = &H000000C0&
Height = 180
Left = 270
TabIndex = 17
Top = 630
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 = 2520
TabIndex = 16
Top = 90
Width = 180
End
End
Attribute VB_Name = "form_WenShuV"
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 Command1_Click()
On Error GoTo e:
If Text7.text = "0" Then
MsgBox "案卷号不能为0！", 32, ""
Exit Sub
End If
If DTPicker3.Value < DTPicker2.Value Then MsgBox "终止时间必须大于起始时间！", 48, "": Exit Sub
If flag = "Insert" Then
flagWhere = ""
'室编档号判断.
'MsgBox fond("T_ARCHIVE_0100_volume", Text3.Text)
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(Text12.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 fand("T_ARCHIVE_0100_volume", Text3.text) > 0 Then
MsgBox "室编档号重复,请核查!", vbExclamation, ""
If Text6.text = "-1" Then
Text6.text = ""
End If
If Text7.text = "-1" Then
Text7.text = ""
End If
Exit Sub
End If
If Text6.text = "" Then
Text6.text = -1
End If
If Text7.text = "" Then
Text7.text = -1
End If
Dim sum As Integer
If Text5.text <> "" And Text6.text <> "-1" And Text7.text <> "-1" Then
strSql = "select count(*) from T_ARCHIVE_0100_volume where FONDS_CODE='" & Text5.text & "' and SERIES_CODE=" & Text6.text & " and FILE_NUMBER=" & Text7.text & ""
rs.Open strSql, conn
sum = rs.Fields(0).Value
'MsgBox sum
rs.Close
If sum > 0 Then
MsgBox "档号重复,请核查!", vbExclamation, ""
Exit Sub
End If
End If '档号重复判断
num = id("T_ARCHIVE_0100_VOLUME")
strSql = "insert into T_ARCHIVE_0100_VOLUME ("
strSql = strSql + "RECORD_SEQUENCE_NUMBER,TITLE_PROPER,DISCRIPTOR,REFERENCE_CODE_OF_FILE_OFFICE,office_name"
strSql = strSql + ",DESCRIBING_DATE,PERSON_FOR_DESCRIPTION,FONDS_CODE,SERIES_CODE,FILE_NUMBER"
strSql = strSql + ",DATE_BEGUN,DATE_FINISHED,TOTAL_QUANTITY,MEDIUM_QUANTITY,SECRET_LEVEL_FOR_DOCUMENTS"
strSql = strSql + ",RETENTION_PERIOD,NOTES_OF_ARCHIVIST,ARCHIVE_YEAR,flag,IS_SHARING"
strSql = strSql + ")values("
strSql = strSql + "" & num & ",'" & Text1.text & "','" & Text2.text & "','" & Text3.text & "','" & Text4.text & "'"
strSql = strSql + ",'" & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" & Text10.text & "','" & Text5.text & "'," & Text6.text & "," & Text7.text & ""
strSql = strSql + ",'" & Format(DTPicker2.Value, "yyyy-mm-dd") & "','" & Format(DTPicker3.Value, "yyyy-mm-dd") & "'," & Text8.text & "," & Text9.text & ",'" & Combo1.ListIndex & "'"
strSql = strSql + ",'" & Combo2.ListIndex & "','" & Text11.text & "','" & Text12.text & "',0,'" & Check1.Value & "'"
strSql = strSql + ")"
Text6.text = ""
Text7.text = "" '案卷号、目录号初始化
ElseIf flag = "Modify" Then
If Text6.text = "" Then
Text6.text = -1
End If
If Text7.text = "" Then
Text7.text = -1
End If
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(Text12.text) <> 4 Then
MsgBox "归档年份请输入4位!", 48, ""
Exit Sub
End If
If fand("T_ARCHIVE_0100_volume", Text3.text) > 0 Then
If Not strfile = Text3.text Then
MsgBox "室编档号重复,请核查!", vbExclamation, ""
If Text6.text = "-1" Then
Text6.text = ""
End If
If Text7.text = "-1" Then
Text7.text = ""
End If
Exit Sub
End If
End If
If Text8.text = "" Then
Text8.text = 0
End If
If Text9.text = "" Then
Text9.text = 0
End If
strSql = "update T_ARCHIVE_0100_VOLUME set "
strSql = strSql + " TITLE_PROPER='" & Text1.text & "',DISCRIPTOR='" & Text2.text & "',REFERENCE_CODE_OF_FILE_OFFICE='" & Text3.text & "'"
strSql = strSql + ",office_name='" & Text4.text & "',DESCRIBING_DATE='" & Format(DTPicker1.Value, "yyyy-mm-dd") & "',PERSON_FOR_DESCRIPTION='" & Text10.text & "',FONDS_CODE='" & Text5.text & "'"
strSql = strSql + ",SERIES_CODE=" & Text6.text & ",FILE_NUMBER=" & Text7.text & ",DATE_BEGUN='" & Format(DTPicker2.Value, "yyyy-mm-dd") & "'"
strSql = strSql + ",DATE_FINISHED='" & Format(DTPicker3.Value, "yyyy-mm-dd") & "',TOTAL_QUANTITY=" & Text8.text & ",MEDIUM_QUANTITY=" & Text9.text & ""
strSql = strSql + ",SECRET_LEVEL_FOR_DOCUMENTS='" & Combo1.ListIndex & "',RETENTION_PERIOD='" & Combo2.ListIndex & "',NOTES_OF_ARCHIVIST='" & Text11.text & "',archive_year='" & Text12.text & "',IS_SHARING='" & Check1.Value & "'"
strSql = strSql + " where RECORD_SEQUENCE_NUMBER=" & num & ""
If ListView2.ListItems.Count > 0 Then
For listI = 1 To ListView2.ListItems.Count
listSql = "update T_ARCHIVE_0100_FILE set REFERENCE_CODE_OF_FILE_OFFICE='" & Text3.text & "',FONDS_CODE='" & Text5.text & "',SERIES_CODE=" & Text6.text & ",FILE_NUMBER=" & Text7.text & " where RECORD_SEQUENCE_NUMBER=" & ListView2.ListItems(listI).SubItems(1) & ""
rs.Open listSql, conn
Next listI
End If
End If
'MsgBox strSql
If Text6.text = "-1" Then
Text6.text = ""
End If
If Text7.text = "-1" Then
Text7.text = ""
End If
rs.Open strSql, conn
MsgBox "保存成功！", vbInformation, ""
If Text6.text = "-1" Then
Text6.text = ""
End If
If Text7.text = "-1" Then
Text7.text = ""
End If
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) = Text8.text
itmX.SubItems(6) = Combo2.text
itmX.SubItems(7) = Text11.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
Dim n As Integer
If MsgBox("确实要移除吗？", vbYesNo + vbQuestion, "") = vbYes Then
For n = 1 To ListView2.ListItems.Count
If ListView2.ListItems(n).Checked Then
rs.Open "update T_ARCHIVE_0100_FILE set flag=0,FONDS_CODE='',SERIES_CODE=0,FILE_NUMBER=1 where RECORD_SEQUENCE_NUMBER=" & ListView2.ListItems(n).SubItems(1) & ""
Dim itmX As ListItem
Set itmX = form_AnJuan.ListView2.ListItems.Add(, , form_AnJuan.ListView1.ListItems.Count + 1)
For i = 1 To 6
itmX.SubItems(i) = ListView2.SelectedItem.SubItems(i)
Next i
End If
Next n
MsgBox "移除成功!", vbExclamation, ""
End If
Call Form_Load
form_AnJuan.Refresh
End Sub
Private Sub Command4_Click()
On Error GoTo e:
' form_PK.Show 1
Dim xlapp As Object, xlbook As Object, xlsheet As Object
Dim strSource, strDestination As String
Dim lop As Integer
Dim numi, numj As Integer
'Dim xlbook As Excel.Workbook
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -