📄 sheet1.frm
字号:
findd = 0
For i = 0 To 10
If Check(i).Value = 1 Then
findd = 1
End If
Next i
If colseled = False Then
MsgBox "先选择计算项目！"
Exit Sub
End If
send = 0
For i = 1 To Crow_max
If grid.TextMatrix(i, 0) = "*********" Then
send = i - 1
'MsgBox send
Exit For
End If
Next
If send = 0 Then
Call MsgBox("在所有学号结束后必需有一个结束标志" + vbCrLf + "*********" + vbCrLf + "解决办法：在此位置点击 编辑/插入行记录结束标志", vbCritical)
Exit Sub
End If
ss = grid.TextMatrix(0, grid.ColSel) + "名次"
For i = 1 To Ccol_max
If grid.TextMatrix(0, i) = ss Or grid.TextMatrix(0, i) = "" Then
ps = i
Exit For
End If
Next
For i = 1 To send
If grid.TextMatrix(i, grid.ColSel) = "" Then
cj(i) = 0
Else
cj(i) = CSng(grid.TextMatrix(i, grid.ColSel))
End If
Next i
Dim mc As Integer
For i = 1 To send
mc = 0
maxcj = cj(i)
For j = 1 To send
If i <> j Then
If cj(j) > maxcj Then
mc = mc + 1
End If
End If
Next j
grid.TextMatrix(i, ps) = mc + 1
Next i
grid.TextMatrix(0, ps) = ss
Exit Sub
ErrHandler:
Call net_ERR_center(1, Err.Number, Err.Description, "")
End Sub
Private Sub menu_col_mul_Click()
If grid.ColSel > 0 And grid.RowSel = Crow_max Then
Frame_muldiv.Visible = True
Label_muldiv.Caption = "选定列<" + grid.TextMatrix(0, grid.ColSel) + ">乘以"
mul_div = C_mul
Else
MsgBox "请先选择一个列！"
End If
Exit Sub
ErrHandler:
Call net_ERR_center(1, Err.Number, Err.Description, "")
End Sub
Private Sub menu_col_paste_Click()
On Error GoTo ErrHandler
Dim k As Integer
If grid.ColSel > 0 And grid.RowSel = Crow_max Then
k = MsgBox("确实要替换《 " + grid.TextMatrix(0, grid.ColSel) + " 》列么？", vbYesNo)
If k = vbYes Then
' grid.Row = Crow_max - 1
' grid.Col = Ccol_max - 1
grid.Clip = Clipboard.GetText
grid.TextMatrix(0, grid.ColSel) = col_name
End If
Else
MsgBox "请先选择一个列！"
End If
Exit Sub
ErrHandler:
Call net_ERR_center(1, Err.Number, Err.Description, "")
End Sub
Private Sub menu_col_sort_Click()
On Error GoTo ErrHandler
Dim i, ps1, ps2 As Integer
ps1 = 0
For i = 1 To Crow_max
If grid.TextMatrix(i, 0) = "*********" Then
ps1 = i
'MsgBox send
Exit For
End If
Next
If ps1 = 0 Then
Call MsgBox("在所有学号结束后必需有一个结束标志" + vbCrLf + "*********" + vbCrLf + "解决办法：在此位置点击 编辑/插入行记录结束标志", vbCritical)
Exit Sub
End If
If grid.ColSel > 0 And grid.RowSel = Crow_max Then
grid.Col = grid.ColSel
grid.Sort = 2
Else
MsgBox "请先选择一个列！"
End If
ps2 = 0
For i = 1 To Crow_max
If grid.TextMatrix(i, 0) = "*********" Then
ps2 = i
'MsgBox send
Exit For
End If
Next
If ps2 = 0 Then
Call MsgBox("在所有学号结束后必需有一个结束标志" + vbCrLf + "*********" + vbCrLf + "解决办法：在此位置点击 编辑/插入行记录结束标志", vbCritical)
Exit Sub
End If
If ps2 > ps1 Then
For i = 1 To ps2 - ps1
Call delete_row(ps1)
Next
End If
Exit Sub
ErrHandler:
Call net_ERR_center(1, Err.Number, Err.Description, "")
End Sub
Private Sub menu_coldiv_Click()
On Error GoTo ErrHandler
If grid.ColSel > 0 And grid.RowSel = Crow_max Then
Frame_muldiv.Visible = True
Label_muldiv.Caption = "选定列<" + grid.TextMatrix(0, grid.ColSel) + ">除以"
mul_div = C_div
Else
MsgBox "请先选择一个列！"
End If
'On Error GoTo ErrHandler
Exit Sub
ErrHandler:
Call net_ERR_center(1, Err.Number, Err.Description, "")
End Sub
Private Sub menu_edit_change_0_Click()
On Error GoTo ErrHandler
Dim itxt As String
itxt = InputBox("请输入字段名", , "标题")
If itxt <> "" Then
grid.TextMatrix(0, 0) = itxt
End If
Exit Sub
ErrHandler:
Call net_ERR_center(1, Err.Number, Err.Description, "")
End Sub
Private Sub menu_edit_change_col_Click()
On Error GoTo ErrHandler
'MsgBox grid.ColSel
Dim itxt As String
If grid.ColSel > 0 And grid.RowSel = Crow_max Then
itxt = InputBox("请输入字段名", , "字段名")
If itxt <> "" Then
grid.TextMatrix(0, grid.ColSel) = itxt
End If
Else
MsgBox "请先选择一个列！"
End If
Exit Sub
ErrHandler:
Call net_ERR_center(1, Err.Number, Err.Description, "")
End Sub
Private Sub menu_edit_change_row_Click()
On Error GoTo ErrHandler
'MsgBox grid.rowSel
Dim itxt As String
If grid.RowSel > 0 And grid.ColSel = Ccol_max Then
itxt = InputBox("请输入字段名", , "记录号")
If itxt <> "" Then
grid.TextMatrix(grid.RowSel, 0) = itxt
End If
Else
MsgBox "请先选择一个行！"
End If
Exit Sub
ErrHandler:
Call net_ERR_center(1, Err.Number, Err.Description, "")
End Sub
Private Sub menu_edit_clear_col_Click()
On Error GoTo ErrHandler
Dim i, j, k As Integer
If grid.ColSel > 0 And grid.RowSel = Crow_max Then
k = MsgBox("确实要清除《 " + grid.TextMatrix(0, grid.ColSel) + " 》列的内容么？", vbYesNo)
If k = vbYes Then
For i = 1 To Crow_max
grid.TextMatrix(i, grid.ColSel) = ""
Next
End If
Else
MsgBox "请先选择一个列！"
End If
Exit Sub
ErrHandler:
Call net_ERR_center(1, Err.Number, Err.Description, "")
End Sub
Private Sub menu_edit_clear_row_Click()
On Error GoTo ErrHandler
Dim i, j, k As Integer
If grid.RowSel > 0 And grid.ColSel = Ccol_max Then
k = MsgBox("确实要清除《 " + grid.TextMatrix(grid.RowSel, 0) + " 》行的内容么？", vbYesNo)
If k = vbYes Then
For i = 1 To Ccol_max
grid.TextMatrix(grid.RowSel, i) = ""
Next
End If
Else
MsgBox "请先选择一个列！"
End If
Exit Sub
ErrHandler:
Call net_ERR_center(1, Err.Number, Err.Description, "")
End Sub
Private Sub menu_edit_delete_col_Click()
On Error GoTo ErrHandler
Dim i, j, k As Integer
If grid.ColSel > 0 And grid.RowSel = Crow_max Then
k = MsgBox("确实要删除《 " + grid.TextMatrix(0, grid.ColSel) + " 》列么？", vbYesNo)
If k = vbYes Then
For i = 0 To Crow_max
For j = grid.ColSel To Ccol_max - 1
grid.TextMatrix(i, j) = grid.TextMatrix(i, j + 1)
Next j
Next
End If
Else
MsgBox "请先选择一个列！"
End If
Exit Sub
ErrHandler:
Call net_ERR_center(1, Err.Number, Err.Description, "")
End Sub
Private Sub menu_edit_delete_row_Click()
On Error GoTo ErrHandler
Dim i, j, k As Integer
If grid.RowSel > 0 And grid.ColSel = Ccol_max Then
If grid.TextMatrix(grid.RowSel, 0) = "*********" Then
MsgBox "记录结束标志*********不能删除！ "
Exit Sub
End If
k = MsgBox("确实要删除《 " + grid.TextMatrix(grid.RowSel, 0) + " 》行么？", vbYesNo)
If k = vbYes Then
For i = 0 To Ccol_max
For j = grid.RowSel To Crow_max - 1
grid.TextMatrix(j, i) = grid.TextMatrix(j + 1, i)
Next j
Next
End If
Else
MsgBox "请先选择一个行！"
End If
Exit Sub
ErrHandler:
Call net_ERR_center(1, Err.Number, Err.Description, "")
End Sub
Private Sub menu_edit_insert_col_Click()
On Error GoTo ErrHandler
Dim i, j As Integer
If grid.ColSel >= 0 Then
For i = 0 To Crow_max
For j = Ccol_max - 1 To grid.ColSel Step -1
grid.TextMatrix(i, j + 1) = grid.TextMatrix(i, j)
Next j
Next
For i = 0 To Crow_max
grid.TextMatrix(i, grid.ColSel) = ""
Next
Text1.Visible = False
End If
Exit Sub
ErrHandler:
Call net_ERR_center(1, Err.Number, Err.Description, "")
End Sub
Private Sub menu_edit_insert_row_Click()
On Error GoTo ErrHandler
Dim i, j As Integer
If grid.RowSel >= 0 Then
For i = 0 To Ccol_max
For j = Crow_max - 1 To grid.RowSel Step -1
grid.TextMatrix(j + 1, i) = grid.TextMatrix(j, i)
Next j
Next
For i = 0 To Ccol_max
grid.TextMatrix(grid.RowSel, i) = ""
Next
Text1.Visible = False
End If
Exit Sub
ErrHandler:
Call net_ERR_center(1, Err.Number, Err.Description, "")
End Sub
Private Sub menu_exit_Click()
Unload Me
End Sub
Private Sub menu_hang_zongfen_Click()
Dim i, j, send, ps, findd As Integer
Dim ssum, ssum1, ssum2 As Single
On Error GoTo ErrHandler
findd = 0
For i = 0 To 11
If Check(i).Value = 1 Then
findd = 1
End If
Next i
If findd = 0 Then
MsgBox "先选择要相加计算项目上的复选按钮！"
Exit Sub
End If
send = 0
For i = 1 To Crow_max
If grid.TextMatrix(i, 0) = "*********" Then
send = i - 1
'MsgBox send
Exit For
End If
Next
If send = 0 Then
Call MsgBox("在所有学号结束后必需有一个结束标志" + vbCrLf + "*********" + vbCrLf + "解决办法：在此位置点击 编辑/插入行记录结束标志", vbCritical)
Exit Sub
End If
For i = 1 To Ccol_max
If grid.TextMatrix(0, i) = "" Or grid.TextMatrix(0, i) = "总分" Then
ps = i
Exit For
End If
Next
ssum1 = 0
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -