?? bbb.frm
字號:
Private Sub mnuFileOpen_Click()
'調用文件打開準備過程
FileOpenProc
End Sub
Private Sub mnuFilePinter_Click()
frmMain.CMDialog1.Flags = cdlPDPrintSetup
frmMain.CMDialog1.ShowPrinter
End Sub
Private Sub mnuFilePrin_Click()
CopyThing 0, ChengJB.Rows - 1, 0, 18
End Sub
Private Sub mnuFileSave_Click()
'檢察文件是否已有文件名,無則 GET,有則使用
Dim strFilename As String
If Left(Me.Caption, 4) = "新成績表" Then
strFilename = GetFileName(strFilename)
Else
strFilename = Me.Caption
End If
If strFilename <> "" Then
SaveFileAs strFilename
End If
End Sub
Private Sub mnuFileSaveAs_Click()
Dim strSaveFilename As String
Dim strDefaultName As String
'將窗體標題賦值給變量
strDefaultName = Me.Caption
If Left(Me.Caption, 4) = "新成績表" Then
strSaveFilename = GetFileName("")
If strSaveFilename <> "" Then SaveFileAs (strSaveFilename)
'更新文件菜單
UpdateFileMenu (strSaveFilename)
Else
'窗體標題包含打開的文件名
strSaveFilename = GetFileName(strSaveFilename)
If strSaveFilename <> "" Then SaveFileAs (strSaveFilename)
'更新文件菜單
UpdateFileMenu (strSaveFilename)
End If
End Sub
Private Sub mnuFileShuxing_Click()
frmShuxing.Show vbModal, frmMain
End Sub
Private Sub mnuFileZong_Click()
filePrintTZ
End Sub
Private Sub mnuHelpAbout_Click()
frmAbout.Show vbModal, frmMain
End Sub
Private Sub mnuhelpmain_Click()
frmHelp.Show vbModal, frmMain
End Sub
Private Sub mnuPrintJian_Click()
filePrintJ
End Sub
Private Sub mnuPrintZong_Click()
filePrintZ
End Sub
Private Sub mnuToolJiang_Click()
Dim i As Integer
With ChengJB
.Sort = 2
.TextArray(Fgi(0, 18)) = "名次"
For i = 1 To .Rows - 1
.TextArray(Fgi((i), 18)) = i
If Val(.TextArray(Fgi((i), 17))) = 0 Then .TextArray(Fgi((i), 18)) = ""
Next
End With
End Sub
Private Sub mnuToolJiangT_Click()
Dim LsShuju As String
LsShuju = ChengJB.Col
ChengJB.Col = 17
mnuToolJiang_Click
ChengJB.Col = LsShuju
End Sub
Private Sub mnuToolJin_Click()
MsgBox "學生成績管理系統 Ver 1.20 (贈送版)" & _
vbCrLf & "暫時沒有此項功能……" & _
vbCrLf & "請留意后續版本!", 48, "抱歉……"
End Sub
Private Sub mnuToolJisuan_Click()
Dim i, j, k As Integer
Dim Abc, dd, ee As Single
Abc = 0
For j = 5 To 12
Zong = Zong + Val(TextShuxing(j).Text)
Next
If Zong = 0 Then Exit Sub
For i = 1 To ChengJB.Rows - 1
Abc = 0
For k = 2 To 9
dd = Val(ChengJB.TextArray(Fgi((i), (k))))
ee = Val(TextShuxing(k + 3).Text)
Abc = Val(Abc) + Val(dd) * Val(ee) / Val(Zong)
Next k
ChengJB.TextArray(Fgi((i), 10)) = Int(Abc * 1000 + 0.5) / 1000
If ChengJB.TextArray(Fgi((i), 10)) = 0 Then ChengJB.TextArray(Fgi((i), 10)) = ""
Abc = Val(ChengJB.TextArray(Fgi((i), 11))) + Val(ChengJB.TextArray(Fgi((i), 12)))
ChengJB.TextArray(Fgi((i), 13)) = Int(Abc * 1000 + 0.5) / 1000
If ChengJB.TextArray(Fgi((i), 13)) = 0 Then ChengJB.TextArray(Fgi((i), 13)) = ""
Abc = Val(ChengJB.TextArray(Fgi((i), 14))) * Val(TextShuxing(3).Text) / 100 + _
Val(ChengJB.TextArray(Fgi((i), 15))) * Val(TextShuxing(4).Text) / 100
ChengJB.TextArray(Fgi((i), 16)) = Int(Abc * 1000 + 0.5) / 1000
If ChengJB.TextArray(Fgi((i), 16)) = 0 Then ChengJB.TextArray(Fgi((i), 16)) = ""
Abc = Val(ChengJB.TextArray(Fgi((i), 10))) * Val(TextShuxing(14).Text) / 100 + _
Val(ChengJB.TextArray(Fgi((i), 13))) * Val(TextShuxing(13).Text) / 100 + _
Val(ChengJB.TextArray(Fgi((i), 16))) * Val(TextShuxing(15).Text) / 100
ChengJB.TextArray(Fgi((i), 17)) = Int(Abc * 100 + 0.5) / 100
If ChengJB.TextArray(Fgi((i), 17)) = 0 Then ChengJB.TextArray(Fgi((i), 17)) = ""
Next i
End Sub
Private Sub mnuToolSheng_Click()
ChengJB.Sort = 1
End Sub
Private Sub mnuToolShengT_Click()
ChengJB.Col = 0
mnuToolSheng_Click
End Sub
Private Sub mnuViewBig_Click()
FontChang 1
End Sub
Private Sub mnuViewGridAo_Click()
ChengJB.GridLines = 2
FState(Me.Tag).Dirty = True
End Sub
Private Sub mnuViewGridColor_Click()
ChengJB.GridLines = 1
frmMain.CMDialog1.Color = ChengJB.GridColor
frmMain.CMDialog1.ShowColor
ChengJB.GridColor = frmMain.CMDialog1.Color
FState(Me.Tag).Dirty = True
End Sub
Private Sub mnuViewGridNone_Click()
ChengJB.GridLines = 0
FState(Me.Tag).Dirty = True
End Sub
Private Sub mnuViewGridPu_Click()
ChengJB.GridLines = 1
FState(Me.Tag).Dirty = True
End Sub
Private Sub mnuViewGridTu_Click()
ChengJB.GridLines = 3
FState(Me.Tag).Dirty = True
End Sub
Private Sub mnuViewLittle_Click()
FontChang -1
End Sub
Private Sub mnuViewSuo_Click()
mnuViewSuo.Checked = Not mnuViewSuo.Checked
If mnuViewSuo.Checked Then
ChengJB.FixedCols = 2
Else
ChengJB.FixedCols = 1
End If
End Sub
Private Sub mnuViewZhuang_Click()
' 切換 Checked 屬性
mnuViewZhuang.Checked = Not mnuViewZhuang.Checked
' 基于值切換工具欄
If mnuViewZhuang.Checked Then
frmMain.sbStatusBar.Visible = True
Else
frmMain.sbStatusBar.Visible = False
End If
End Sub
Private Sub mnuWindowArrangeIcons_Click()
frmMain.Arrange vbArrangeIcons
End Sub
Private Sub mnuViewToolbar_Click()
' 切換 Checked 屬性
mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
' 基于值切換工具欄
If mnuViewToolbar.Checked Then
frmMain.tbToolBar.Visible = True
Else
frmMain.tbToolBar.Visible = False
End If
End Sub
Private Sub mnuWindowCascade_Click()
frmMain.Arrange vbCascade
End Sub
Private Sub mnuWindowTileH_Click()
frmMain.Arrange vbTileHorizontal
End Sub
Private Sub mnuWindowTileZ_Click()
frmMain.Arrange vbTileVertical
End Sub
Private Sub TextShuxing_Change(Index As Integer)
FState(Me.Tag).Dirty = True
End Sub
Private Sub Timer1_Timer()
Text1.Visible = Not Text1.Visible
End Sub
Sub txtEdit_KeyPress(keyascii As Integer)
'刪除回車符,以消除嘟嘟聲。
If keyascii = vbKeyReturn Then
keyascii = 0
With ChengJB
If frmMain.ActiveForm.mnuEditKemu.Checked Then '按列輸入
If .Row <> .Rows - 1 Then '這一列沒有輸入完
.Row = .Row + 1 '轉到此列的下一行
Else '如果這一列已經輸入完
.Row = 1 '回到第一行
Select Case .Col
Case 9
.Col = .Col + 2 '跳過 ∑智育
Case 12
.Col = .Col + 2 '跳過 ∑德育
Case 15
.Col = 1
.Row = 1
Exit Sub '全部輸入完,退出過程
Case Else
.Col = .Col + 1 '到下一列
End Select
End If
End If
If frmMain.ActiveForm.mnuEditCheng.Checked Then '按行輸入
If .Col <> 15 Then '這一行沒有輸入完
Select Case .Col
Case 9
.Col = .Col + 2 '跳過 ∑智育
Case 12
.Col = .Col + 2 '跳過 ∑德育
Case Else
.Col = .Col + 1 '到下一列
End Select
Else
.Col = 2
If .Row <> .Rows - 1 Then '如果沒有到達最后一行
.Row = .Row + 1 '將行號加 1
Else '如果到達了最后一行
.Col = 1
.Row = 1
Exit Sub '退出過程
End If
End If
End If
End With
End If
End Sub
Sub txtEdit_KeyDown(KeyCode As Integer, _
Shift As Integer)
EditKeyCode ChengJB, txtedit, KeyCode, Shift
End Sub
Sub EditKeyCode(MSFlexGrid As Control, Edt As _
Control, KeyCode As Integer, Shift As Integer)
'標準編輯控件處理。
Select Case KeyCode
Case 27 'ESC:隱藏焦點并將其返回 MSFlexGrid。
Edt.Visible = False
MSFlexGrid.SetFocus
Case 13 'ENTER 將焦點返回 MSFlexGrid。
MSFlexGrid.SetFocus
Case 38 '向上。
MSFlexGrid.SetFocus
DoEvents
If MSFlexGrid.Row > MSFlexGrid.FixedRows Then
MSFlexGrid.Row = MSFlexGrid.Row - 1
End If
Case 40 '向下。
MSFlexGrid.SetFocus
DoEvents
If MSFlexGrid.Row < MSFlexGrid.Rows - 1 Then
MSFlexGrid.Row = MSFlexGrid.Row + 1
End If
End Select
End Sub
Sub ChengJB_GotFocus()
Dim lsShu As Integer
If mnuEditAuto.Checked Then
mnuToolJisuan.Enabled = True
mnuToolJisuan_Click
mnuToolJisuan.Enabled = False
End If
If mnuEditAutoP.Checked Then
mnuToolJiangT.Enabled = True
mnuToolJiangT_Click
mnuToolJiangT.Enabled = False
lsShu = ChengJB.Col
ChengJB.Col = 0
ChengJB.Sort = 1
ChengJB.Col = lsShu
End If
If txtedit.Visible = False Then Exit Sub
ChengJB = txtedit
txtedit.Visible = False
End Sub
Sub ChengJB_LeaveCell()
If txtedit.Visible = False Then Exit Sub
ChengJB = txtedit
txtedit.Visible = False
End Sub
Private Sub mnuRecentFile_click(Index As Integer)
'調用文件打開過程,傳遞一個對該窗體實例的引用
OpenFile (mnuRecentFile(Index).Caption)
'更新文件菜單
GetRecentFiles
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -