?? 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 '是否處于修改狀態(tài)
Public AddNew As Boolean '是否處于添加狀態(tài)
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 + -