📄 form_wenshuf.frm
字号:
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "文件编号"
Height = 180
Left = 450
TabIndex = 22
Top = 2355
Width = 720
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "题名"
ForeColor = &H000000C0&
Height = 180
Left = 450
TabIndex = 21
Top = 1110
Width = 360
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "件号"
Height = 180
Left = 5250
TabIndex = 20
Top = 630
Width = 360
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "室编档号"
ForeColor = &H000000C0&
Height = 180
Left = 450
TabIndex = 19
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 = 2460
TabIndex = 18
Top = 90
Width = 180
End
End
Attribute VB_Name = "form_WenShuF"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strfile As String
Dim strpage 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 Command1_Click()
On Error GoTo e:
If Text8.text = 0 Then
MsgBox "页数不能为0!", 48, ""
Exit Sub
End If
If Text1.text = "" Or Text1.text = " " Then
MsgBox "请输入室编档号！", vbExclamation, ""
Exit Sub
End If
If Text2.text = "" Or Text2.text = " " Then
MsgBox "请输入题名！", vbExclamation, ""
Exit Sub
End If
If Text9.text = "" Or Text9.text = " " Then
MsgBox "请输入责任者！", vbExclamation, ""
Exit Sub
End If
If flag = "Insert" Then
'Dim sfond As Integer
' sfond = 0
' Dim sum2 As Integer
' strSql = "select count(*) from T_ARCHIVE_0100_file where REFERENCE_CODE_OF_FILE_OFFICE='" + Text1.Text + "'" + " and file_number<>0"
' Debug.Print strSql
' rs.Open strSql, conn
' sum2 = rs.Fields(0).Value
' Debug.Print sum2
' rs.Close
' sfond = sum2
' If sfond > 0 Then
' MsgBox "室编档号重复,请重输!", vbExclamation, ""
' Exit Sub
' End If
If fond("T_ARCHIVE_0100_file", Text1.text, Text5.text) > 0 Then
MsgBox "在室编档号重复的情况下,件号不可重复，请核查!", vbExclamation, ""
Exit Sub
End If
num = id("T_ARCHIVE_0100_FILE")
strSql = "insert into T_ARCHIVE_0100_FILE ("
strSql = strSql + "RECORD_SEQUENCE_NUMBER,REFERENCE_CODE_OF_FILE_OFFICE,TITLE_PROPER,DOCUMENT_CODE,DATE_BEGUN"
strSql = strSql + ",SECRET_LEVEL_FOR_DOCUMENTS,RETENTION_PERIOD,NUMBER_OF_PAGE,ARCHIVE_YEAR"
strSql = strSql + ",DISCRIPTOR,ITEM_NUMBER,PRIMARY_CREATOR,SUBORDINATE_CREATOR"
strSql = strSql + ",ELECTRONIC_RECORD_CODE,VERSION,NOTES_OF_ARCHIVIST,ATTENDANT_DOCUMENT,flag"
strSql = strSql + ",file_number,IS_SHARING"
strSql = strSql + ")values("
strSql = strSql + "" & num & ",'" & Text1.text & "','" & Text2.text & "','" & Text3.text & "','" & Format(DTPicker1.Value, "yyyy-mm-dd") & "'"
strSql = strSql + ",'" & Combo1.ListIndex & "','" & Combo2.ListIndex & "'," & Text5.text & ",'" & Text6.text & "'"
strSql = strSql + ",'" & Text7.text & "','" & Trim(Text8.text) & "','" & Text9.text & "','" & Text10.text & "' "
strSql = strSql + ",'" & Text11.text & "','" & Combo3.text & "','" & Text13.text & "','" & Text14.text & "',0"
strSql = strSql + ",'1','" & Check1.Value & "'" 'file_number置1，初始化
strSql = strSql + ")"
ElseIf flag = "Modify" Then
If fond("T_ARCHIVE_0100_file", Text1.text, Text5.text) > 0 Then
If Not (strpage = Text5.text And strfile = Text1.text) Then
MsgBox "在室编档号重复的情况下,件号不可重复，请核查!", vbExclamation, ""
Exit Sub
End If
End If
strSql = "update T_ARCHIVE_0100_file set "
strSql = strSql + "REFERENCE_CODE_OF_FILE_OFFICE='" & Text1.text & "',TITLE_PROPER ='" & Text2.text & "',DOCUMENT_CODE ='" & Text3.text & "',DATE_BEGUN ='" & Format(DTPicker1.Value, "yyyy-mm-dd") & "'"
strSql = strSql + ",SECRET_LEVEL_FOR_DOCUMENTS ='" & Combo1.ListIndex & "',RETENTION_PERIOD ='" & Combo2.ListIndex & "',NUMBER_OF_PAGE =" & Text5.text & ",ARCHIVE_YEAR ='" & Text6.text & "'"
strSql = strSql + ",DISCRIPTOR ='" & Text7.text & "',ITEM_NUMBER ='" & Trim(Text8.text) & "',PRIMARY_CREATOR ='" & Text9.text & "',SUBORDINATE_CREATOR ='" & Text10.text & "'"
strSql = strSql + ",ELECTRONIC_RECORD_CODE ='" & Text11.text & "',VERSION ='" & Combo3.text & "',NOTES_OF_ARCHIVIST ='" & Text13.text & "',ATTENDANT_DOCUMENT ='" & Text14.text & "',IS_SHARING='" & Check1.Value & "' "
strSql = strSql + " where RECORD_SEQUENCE_NUMBER=" & num & ""
End If
'MsgBox strSql
rs.Open strSql, conn
MsgBox "保存成功！", vbInformation, ""
lblState.Caption = returnInputState(Label2, Text1, Label3, Text5)
If flag = "Insert" Then
Text5.text = numberPage("t_archive_0100_file", Text1.text)
Dim itmX As ListItem
Set itmX = form_AnJuan.ListView2.ListItems.Add(, , Text5.text)
itmX.SubItems(1) = num
itmX.SubItems(2) = Text1.text
itmX.SubItems(3) = Text3.text
itmX.SubItems(4) = Text2.text
itmX.SubItems(5) = Text9.text
itmX.SubItems(6) = Replace(Format(DTPicker1.Value, "yyyy-mm-dd"), "-", ".")
End If
If flag = "Insert" Then
Text8.text = "0"
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 Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub Form_Load()
backColor = bgColor
Label1.Caption = form_AnJuan.Label4.Caption + "卷内文件信息"
Label1.backColor = bgColor
Combo1.AddItem "公开"
Combo1.AddItem "限制"
Combo1.AddItem "秘密"
Combo1.AddItem "机密"
Combo1.ListIndex = 1
Combo2.AddItem "永久"
Combo2.AddItem "长期"
Combo2.AddItem "短期"
Combo2.ListIndex = 0
Combo3.AddItem "正本"
Combo3.AddItem "副本"
Combo3.AddItem "草稿"
Combo3.AddItem "定稿"
Combo3.ListIndex = 0
Text1.text = ""
Text2.text = ""
Text3.text = ""
Text5.text = 0
Text6.text = Format(Date, "yyyy")
Text7.text = ""
Text8.text = 0
Text9.text = ""
Text10.text = ""
Text11.text = ""
Text13.text = ""
Text14.text = ""
Text4.text = ""
Text4.MaxLength = 5
DTPicker1.Value = Date
If flag = "Modify" Then
rs.Open "select * from T_ARCHIVE_0100_FILE where RECORD_SEQUENCE_NUMBER=" & num & "", conn
If rs!REFERENCE_CODE_OF_FILE_OFFICE <> "" Then
Text1.text = rs!REFERENCE_CODE_OF_FILE_OFFICE
End If
If rs!TITLE_PROPER <> "" Then
Text2.text = rs!TITLE_PROPER
End If
If rs!DOCUMENT_CODE <> "" Then
Text3.text = rs!DOCUMENT_CODE
End If
If rs!DATE_BEGUN <> "" Then
DTPicker1.Value = rs!DATE_BEGUN
End If
If rs!SECRET_LEVEL_FOR_DOCUMENTS <> "" Then
Combo1.ListIndex = rs!SECRET_LEVEL_FOR_DOCUMENTS
End If
If rs!RETENTION_PERIOD <> "" Then
Combo2.ListIndex = rs!RETENTION_PERIOD
End If
If rs!NUMBER_OF_PAGE <> "" Then
Text5.text = rs!NUMBER_OF_PAGE
End If
If rs!ARCHIVE_YEAR <> "" Then
Text6.text = rs!ARCHIVE_YEAR
End If
If rs!DISCRIPTOR <> "" Then
Text7.text = rs!DISCRIPTOR
End If
'' If rs!ITEM_NUMBER <> "" Then
'' Text8.Text = rs!ITEM_NUMBER
'' End If
Dim k As Integer
k = InStr(xml("ITEM_NUMBER"), "-")
If k <> 0 Then
Text8.text = Mid(xml("ITEM_NUMBER"), 1, k - 1)
Text4.text = Mid(xml("ITEM_NUMBER"), k + 1)
Else
Text8.text = xml("ITEM_NUMBER")
End If
'页号处理
If rs!PRIMARY_CREATOR <> "" Then
Text9.text = rs!PRIMARY_CREATOR
End If
If rs!SUBORDINATE_CREATOR <> "" Then
Text10.text = rs!SUBORDINATE_CREATOR
End If
If rs!ELECTRONIC_RECORD_CODE <> "" Then
Text11.text = rs!ELECTRONIC_RECORD_CODE
End If
If rs!Version <> "" Then
Combo3.text = rs!Version
End If
If rs!NOTES_OF_ARCHIVIST <> "" Then
Text13.text = rs!NOTES_OF_ARCHIVIST
End If
If rs!ATTENDANT_DOCUMENT <> "" Then
Text14.text = rs!ATTENDANT_DOCUMENT
End If
If xml("IS_SHARING") <> "" Then
Check1.Value = xml("IS_SHARING")
End If
rs.Close
End If
Text1.MaxLength = 24
Text2.MaxLength = 1000
Text3.MaxLength = 50
Text5.MaxLength = 6
Text6.MaxLength = 10
Text7.MaxLength = 100
Text8.MaxLength = 5
Text9.MaxLength = 255
Text10.MaxLength = 255
Text11.MaxLength = 50
Text13.MaxLength = 1000
Text14.MaxLength = 255
strfile = Text1.text
strpage = Text5.text
End Sub
Private Sub Text1_Change()
If flag = "Insert" Then
Text5.text = numberPage("t_archive_0100_file", Text1.text)
End If
End Sub
Private Sub Text5_KeyPress(KeyAscii As Integer)
If Not (KeyAscii > 47 And KeyAscii < 59) And KeyAscii <> 8 Then
KeyAscii = 0
MsgBox "请输入数字!", 48, ""
End If
End Sub
Private Sub Text8_KeyPress(KeyAscii As Integer)
If Not (KeyAscii > 47 And KeyAscii < 59) And KeyAscii <> 8 Then
KeyAscii = 0
MsgBox "请输入数字!", 48, ""
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -