📄 form_kejiv.frm
字号:
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "编制单位"
Height = 180
Left = 4200
TabIndex = 16
Top = 1980
Width = 720
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "保管期限"
Height = 180
Left = 4185
TabIndex = 15
Top = 2850
Width = 720
End
Begin VB.Label Label7
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "终止时间"
Height = 180
Left = 4185
TabIndex = 14
Top = 1530
Width = 720
End
Begin VB.Label Label9
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "单位"
Height = 180
Left = 2970
TabIndex = 13
Top = 1980
Width = 360
End
Begin VB.Label Label11
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "著录者"
Height = 180
Left = 4155
TabIndex = 12
Top = 5610
Width = 540
End
Begin VB.Label Label12
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "著录时间"
Height = 180
Left = 450
TabIndex = 11
Top = 5580
Width = 720
End
Begin VB.Label Label15
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "归档年份"
ForeColor = &H000000C0&
Height = 180
Left = 4200
TabIndex = 10
Top = 2430
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 = 1800
TabIndex = 9
Top = 120
Width = 180
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "室编档号"
ForeColor = &H000000C0&
Height = 180
Left = 450
TabIndex = 8
Top = 630
Width = 720
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "题名"
ForeColor = &H000000C0&
Height = 180
Left = 450
TabIndex = 7
Top = 1065
Width = 360
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "密级"
Height = 180
Left = 450
TabIndex = 6
Top = 2820
Width = 360
End
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "起始时间"
Height = 180
Left = 450
TabIndex = 5
Top = 1500
Width = 720
End
Begin VB.Label Label8
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "数量"
Height = 180
Left = 450
TabIndex = 4
Top = 1950
Width = 360
End
Begin VB.Label Label10
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "载体类型"
Height = 180
Left = 450
TabIndex = 3
Top = 2385
Width = 720
End
Begin VB.Label Label13
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "备注"
Height = 180
Left = 450
TabIndex = 2
Top = 4590
Width = 360
End
Begin VB.Label Label14
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "主题词"
Height = 180
Left = 450
TabIndex = 1
Top = 4140
Width = 540
End
Begin VB.Label Label16
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "全宗号"
Height = 180
Left = 450
TabIndex = 0
Top = 3255
Width = 540
End
End
Attribute VB_Name = "form_KeJiV"
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 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 DTPicker3.Value < DTPicker2.Value Then MsgBox "终止时间必须大于起始时间！", 48, "": Exit Sub
If Text10.text = "" Then
Text10.text = 0
End If
If fand2("T_ARCHIVE_0300_volume", Text3.text) > 0 Then
If flag = "Insert" Then
MsgBox "室编档号重复,请核查!", vbExclamation, ""
Exit Sub
Else
If Not (strfile = Text3.text) Then
MsgBox "室编档号重复,请核查!", vbExclamation, ""
Exit Sub
End If
End If
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(Text9.text) <> 4 Then
MsgBox "归档年份请输入4位!", 48, ""
Exit Sub
End If
'归档年分位数判断
Text4.text = Combo4.text
If Me.DTPicker3.Value < Me.DTPicker2.Value Then
MsgBox "终止时间不应小于起始时间！", 48, ""
Exit Sub
End If
If flag = "Insert" Then
flagWhere = ""
Dim sum As Integer
If Text5.text <> "" And Text6.text <> "" And Text7.text <> "" And Text13.text <> "" And Text14.text <> "" And Text15.text <> "" Then
strSql = "select count(*) from T_ARCHIVE_0300_volume where FONDS_CODE='" & Text5.text & "' and ITEM_CODE='" & Text13.text & "' and STAGE_CODE='" & Text14.text & "' and SERIES_CODE='" & Text6.text & "' and FILE_NUMBER='" & Text7.text & "' and SERIAL_NUMBER='" & Text15.text & "'"
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_0300_VOLUME")
strSql = "insert into T_ARCHIVE_0300_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 + ",series_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,authorized_unit"
strSql = strSql + ",ITEM_CODE,STAGE_CODE,SERIAL_NUMBER,IS_SHARING"
strSql = strSql + ")values("
strSql = strSql + "" & num & ",'" & Text1.text & "','" & Text2.text & "','" & Text3.text & "' ,'" & Format(DTPicker1.Value, "yyyy-mm-dd") & "'"
strSql = strSql + ",'" & Text4.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,'" & Text12.text & "'"
strSql = strSql + ",'" & Text13.text & "','" & Text14.text & "','" & Text15.text & "','" & Check1.Value & "'"
strSql = strSql + ")"
ElseIf flag = "Modify" Then
strSql = "update T_ARCHIVE_0300_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 ='" & Text4.text & "' ,PERSON_FOR_DESCRIPTION ='" & Text8.text & "' ,FONDS_CODE ='" & Text5.text & "' ,series_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 & "',authorized_unit='" & Text12.text & "'"
strSql = strSql + ",ITEM_CODE='" & Text13.text & "',STAGE_CODE='" & Text14.text & "',SERIAL_NUMBER='" & Text15.text & "',IS_SHARING='" & Check1.Value & "'"
strSql = strSql + " where RECORD_SEQUENCE_NUMBER=" & num & ""
For listI = 1 To ListView2.ListItems.Count
listSql = "update T_ARCHIVE_0300_FILE set REFERENCE_CODE_OF_FILE_OFFICE='" & Text3.text & "',FONDS_CODE='" & Text5.text & "',ITEM_CODE='" & Text13.text & "',STAGE_CODE='" & Text14.text & "',SERIES_CODE='" & Text6.text & "',FILE_NUMBER='" & Text7.text & "',SERIAL_NUMBER='" & Text15.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_0300_FILE set flag=0,FONDS_CODE='',ITEM_CODE='',STAGE_CODE='',SERIES_CODE='',FILE_NUMBER='',SERIAL_NUMBER='' where RECORD_SEQUENCE_NUMBER=" & ListView2.SelectedItem.SubItems(1) & ""
MsgBox "移除成功!", vbExclamation, ""
Dim itmX As ListItem
Set itmX = form_AnJuan.ListView2.ListItems.Add(, , form_AnJuan.ListView1.ListItems.Count + 1)
For i = 1 To 5
itmX.SubItems(i) = ListView2.SelectedItem.SubItems(i)
Next i
ListView2.ListItems.Remove (ListView2.SelectedItem.Index)
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
'Dim xlsheet As Excel.Worksheet
Screen.MousePointer = vbHourglass
Set xlapp = CreateObject("Excel.Application")
xlapp.Visible = False
' If A4 = "A4" Then
If Right(App.Path, 1) = "\" Then
strSource = App.Path & "excel\grid.xls"
strDestination = App.Path & "excel\temp.xls"
Else
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -