⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sheet3.frm

📁 学生成绩管理系统
💻 FRM
📖 第 1 页 / 共 5 页
字号:
On Error GoTo ErrHandler

'Dim colseled As Boolean
If grid.ColSel > 0 And grid.RowSel = Crow_max Then
   colseled = True
            
End If





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

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -