📄 frmforshsjb.frm
字号:
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 1170
TabIndex = 4
Text = " "
Top = 1260
Width = 1395
End
Begin VB.Label Label1
Alignment = 2 'Center
BackColor = &H00E0E0E0&
BackStyle = 0 'Transparent
Caption = "学号"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 375
Left = 150
TabIndex = 20
Top = 270
Width = 1095
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H00E0E0E0&
BackStyle = 0 'Transparent
Caption = "姓名"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 375
Left = 2670
TabIndex = 19
Top = 270
Width = 1095
End
Begin VB.Label Label3
Alignment = 2 'Center
BackColor = &H00E0E0E0&
BackStyle = 0 'Transparent
Caption = "院系"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 375
Left = 150
TabIndex = 18
Top = 810
Width = 1095
End
Begin VB.Label Label4
Alignment = 2 'Center
BackColor = &H00E0E0E0&
BackStyle = 0 'Transparent
Caption = "电话"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 375
Left = 2670
TabIndex = 17
Top = 810
Width = 1095
End
Begin VB.Label Label5
Alignment = 2 'Center
BackColor = &H00E0E0E0&
BackStyle = 0 'Transparent
Caption = "班级"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 375
Left = 150
TabIndex = 16
Top = 1350
Width = 1095
End
End
Begin VB.TextBox txtJL
BackColor = &H00FFFFFF&
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 1695
Left = 60
MultiLine = -1 'True
TabIndex = 7
Text = "frmForSHSJB.frx":18C0
Top = 3060
Width = 5535
End
Begin VB.Line Line2
BorderColor = &H00000000&
X1 = 30
X2 = 840
Y1 = 0
Y2 = 0
End
Begin VB.Label Label8
BackStyle = 0 'Transparent
Caption = "社会活动经历:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 375
Left = 90
TabIndex = 6
Top = 2730
Width = 2415
End
Begin VB.Menu MNUFILE
Caption = "【文件&F】"
Begin VB.Menu MNUEXIT
Caption = "退出[&X]"
End
End
Begin VB.Menu MNULOC
Caption = "【记录定位&L】"
Begin VB.Menu MNUXH
Caption = "学号定位[&O]"
End
End
Begin VB.Menu MNUPRINT
Caption = "【打印&P】"
Begin VB.Menu MNUVIEW
Caption = "打印预览[&V]"
End
End
Begin VB.Menu MNUHELP
Caption = "【帮助&H】"
Begin VB.Menu MNUNOTE
Caption = "使用说明[&N]"
End
End
End
Attribute VB_Name = "frmForSHSJB"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public recForSHSJB As Recordset '浏览,删除,修改时检索用数据表
Public BookMark As Integer '数据表标志号
Public RecordCount As Integer '数据表记录数
Public Modify As Boolean '是否处于修改状态
Public AddNew As Boolean '是否处于添加状态
Dim ex As Excel.Application
Dim exwbook As Excel.WorkBook
Dim exsheet As Excel.WorkSheet
Dim exchart As Excel.Chart
Dim I, J As Integer
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Unload Me
End Sub
Private Sub MNUEXIT_Click()
Unload Me
End Sub
Private Sub MNUNOTE_Click()
Dim TTT As String
Dim X
TTT = App.Path + "\HELP\SHSJB.TXT"
X = Shell("Notepad " + TTT, 1)
End Sub
Private Sub MNUVIEW_Click()
If MsgBox("将要处理数据,可能花费较长时间,请稍候……", vbInformation + vbOKCancel, "提示框") = vbCancel Then
Exit Sub
Screen.MousePointer = 0
Else
Set ex = CreateObject("excel.application")
Set exwbook = ex.Workbooks().Add
Set exsheet = exwbook.Worksheets("sheet1")
Dim rec As Recordset
Dim q As Integer
Screen.MousePointer = 11
Set rec = recForSHSJB
'rec.MoveFirst
If rec.AbsolutePosition = -1 Then
MsgBox "无信息可供打印,退出!", vbExclamation, "错误信息"
GoTo 10
End If
rec.MoveLast
rec.MoveFirst
q = rec.RecordCount
ex.Caption = "学生社会实践材料一览"
ex.Cells(1, 5).Value = "学生社会实践材料报表"
ex.Cells(3, 1).Value = "学号"
ex.Cells(3, 2).Value = "姓名"
ex.Cells(3, 3).Value = "班级"
ex.Cells(3, 4).Value = "院系"
ex.Cells(3, 5).Value = "电话"
ex.Cells(3, 6).Value = "实践经历"
ex.Cells(3, 7).Value = "社会工作"
For I = 4 To q + 3
For J = 1 To 7
ex.Cells(I, J).Value = rec(J).Value
Next J
rec.MoveNext
Next I
ex.Visible = True
exwbook.Saved = True
rec.MoveFirst
10:
Screen.MousePointer = vbArrow
Set exsheet = Nothing
Set exwbook = Nothing
Set ex = Nothing
End If
End Sub
Private Sub MNUXH_Click()
On Error Resume Next
XH = ""
frmDinW.Show vbModal
If Len(XH) <> 0 Then
recForSHSJB.FindFirst "xh='" + Trim(XH) + "' "
If recForSHSJB.NoMatch Then
MsgBox "学号不存在!", vbExclamation + vbOKOnly, "提示"
Else
FillIn
End If
End If
BookMark = recForSHSJB.AbsolutePosition + 1
End Sub
Private Sub txtGZ_KeyPress(KeyAscii As Integer)
On Error Resume Next
Dim sqlModify As String
Dim BookMarkSave As Integer
Dim I As Integer
If KeyAscii = 13 Then
If Modify Then
sqlModify = "update shsjb set gz='" + Trim(txtGZ) + "' where id=" + Trim(recForSHSJB!ID) + ""
Dbstudent.Execute sqlModify, 64
If MsgBox("保存对当前记录的修改?", vbQuestion + vbYesNo) = vbNo Then
Exit Sub
End If
cmdSave.Caption = "保存"
cmdSave.Enabled = False
BookMarkSave = BookMark
UpdateRecord
For I = 1 To BookMarkSave - 1
recForSHSJB.MoveNext
FillIn
Next I
BookMark = BookMarkSave
Modify = False
cmdModify.Enabled = True
cmdNext.Enabled = True
cmdPrevious.Enabled = True
End If
End If
End Sub
Private Sub cmdDelete_Click()
'On Error Resume Next
Dim sqlForDelete As String
If txtXH = " " Then
MsgBox "无学号!", vbInformation, "提示"
Else
If XHInSHSJB(txtXH) Then
If MsgBox("确信删除此记录?", vbQuestion + vbOKCancel) = vbOK Then
sqlForDelete = "delete from shsjb where xh='" + Trim(recForSHSJB!XH) + "' and gz='" + Trim(recForSHSJB!GZ) + "'"
Dbstudent.Execute sqlForDelete, 64
InitItem
UpdateRecord
FillIn
End If
Else
MsgBox "表中无此记录!", vbExclamation, "提示"
End If
End If
End Sub
Private Sub cmdExit_Click()
On Error Resume Next
txtXH.Text = "1"
Me.Hide
Unload Me
End Sub
Private Sub cmdModify_Click()
On Error Resume Next
If txtXH = " " Then
MsgBox "无可用信息", vbExclamation, "提示"
Exit Sub
Else
If XHInSHSJB(txtXH) Then
cmdSave.Enabled = True
cmdSave.Caption = "存储"
Modify = True
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -