tblstru.frm

我编的学分管理程序,应用程序 原代码都有!VB入门的好东西

kaishifrm.List2.Enabled = True
End Sub

Private Sub lstFields_Click()

txtfieldName.Text = lstFields.List(lstFields.ListIndex)
Select Case Trim(txtfieldName)
Case "学号"
comovfld.Enabled = False
Cmdputin.Enabled = False
Case "平均分"
Cmdputin.Enabled = False
comovfld.Enabled = False
Case "平均"
Cmdputin.Enabled = False
comovfld.Enabled = False
Case "学分"
comovfld.Enabled = False
Cmdputin.Enabled = False
Case "总分"
Cmdputin.Enabled = False
comovfld.Enabled = False
Case "姓名"
If Trim(Trim(txtTableName.Text)) = "基本表" Then
 Cmdputin.Enabled = True
 Else
 Cmdputin.Enabled = False
 End If
comovfld.Enabled = False
Case Else
comovfld.Enabled = True
Cmdputin.Enabled = True
Cmdputin.Enabled = True
End Select


If Cmdputin.Enabled = True Then
If Frmputinshow = 1 Then

 Unload FrmPutIn


cmdputin_Click
End If
End If

'If Left(Trim(txtfieldName), 2) = "总分" Then
'Cmdputin.Enabled = False
'cmdadd.Enabled = False
'comovfld.Enabled = False
'End If


'=======以下保留!
'If Trim(txtfieldName) = "学号" Then
'Cmdputin.Enabled = False
'comovfld.Enabled = False
'Else
'comovfld.Enabled = True
'Cmdputin.Enabled = True
'End If

'If Trim(Trim(txtTableName.Text)) <> "基本表" Then 'IF 1

 'If Trim(txtfieldName) = "姓名" Then
  'Cmdputin.Enabled = False
  'Else
  'Cmdputin.Enabled = True

  'End If
   'comovfld.Enabled = False
   
   
  ' Else 'IF1
   'If Trim(txtfieldName) = "平均分" Or Trim(txtfieldName) = "学分" Then
   'Cmdputin.Enabled = False
  'Else
  'Cmdputin.Enabled = True

 ' End If
 'End If
 
 


End Sub
Private Sub txtFieldName_Change()
  
  '只有“名称”（name）字段有内容时，才激活“确定”（OK）按钮
 If Trim(txtfieldName.Text) <> "姓名" And Trim(txtfieldName.Text) <> "学号" Then
 
 cmdadd.Enabled = (Len(Trim(txtfieldName.Text)) > 1)
 
Else
cmdadd.Enabled = False
End If

 End Sub
Private Sub txtfieldName_Click()
If txtfieldName.Text <> "姓名" And txtfieldName.Text <> "学号" Then _
 cmdadd.Enabled = (Len(Trim(txtfieldName.Text)) > 1)

End Sub

Private Sub Form_Load()

frmTblStruct.lstFields.Clear
'If worktype = 3 Then
' Set scoretab = dbname.TableDefs()
'End If
'coverFrm.Width = 9990
kaishifrm.List2.Enabled = False
frmTblStruct.Left = kaishifrm.Width + 30
frmTblStruct.Top = 0
For i = 0 To scoretab.Fields.Count - 1
frmTblStruct.lstFields.AddItem scoretab.Fields(i).Name
Next i
frmTblStruct.Caption = GY
txtTableName.Text = "  " & Name1
cboFieldType.AddItem "数字"
   cboFieldType.ItemData(cboFieldType.NewIndex) = dbSingle
   'cboFieldType.AddItem " 优.良.及"
   'cboFieldType.ItemData(cboFieldType.NewIndex) = dbText
   'cboFieldType.Text = "数字"
 
End Sub
Private Sub cboFieldType_GotFocus()
MsgBox " “数据”为缺省选项,定义列的内容类型! "
End Sub
Private Sub cmdadd_Click()
 
  On Error GoTo show1
 Dim fenrecord As Recordset
 Dim fld As Field     '字段结构局部变量

Dim tjoption ' 定义输入的科目是学分还是统计分
If Frmputinshow = 1 Then

If MsgBox("添加新科目,您将退出录入学分!", vbOKCancel, TiShi) = vbOK Then
Unload FrmPutIn
End If
End If
tjoption = 0 '  0   为学分统计

 '========位置未定!
  Select Case Trim(Trim(txtfieldName))
   Case "德育", "加分", "减分"
   Set fld = scoretab.CreateField
 
  fld.Name = Trim(Trim(txtfieldName))
  tjoption = 1 ' 为总分统计
  
  GoTo f1 '跳转
  
  Case "学分", "平均", "总分"
  MsgBox "自动统计出该成绩,无须添加!"
  Exit Sub
 End Select
 Const MSG1 = "科已存在"

If Len(Combo1.Text) = 0 Or (OpZU.Value Or OpFU.Value) = 0 Then
  Beep
MsgBox "信息不全!"
 Exit Sub
End If
'定义系数变量=====================
If OpZU.Value = True Then
KEoption = "主"
xishuS = Combo1.Text
Else
KEoption = "副"
xishuS = Combo1.Text * 0.8
End If
'=================================

  '得到一个新字段（field）对象
 '================================
  Set fld = scoretab.CreateField
  '填充字段结构
  With fld
        .Required = False '允许非空
      If .Type = dbText Then
        '仅用于 text
        .AllowZeroLength = True '允许长度为0
      End If
           '.Attributes = dbFixedField + dbUpdatableField '我
    For i = 0 To 4
    txtfieldName.Text = Trim(txtfieldName.Text)
    
    Next i
     If Right(txtfieldName.Text, 1) <> ")" Then
     txtfieldName = txtfieldName.Text & "(" & KEoption & ")"
     End If
f1:
    
    fld.Name = txtfieldName.Text
    fld.Type = dbText 'cboFieldType.ItemData(cboFieldType.ListIndex)?/?
    'fld.AllowZeroLength = True
    fld.Size = Len(txtfieldName) + 4
  
  End With
  

  '检查有无重复
  If ObjectExists(scoretab.Fields, fld.Name) Then
    Beep
    MsgBox "'" & fld.Name & "'" & MSG1
    txtfieldName.SelStart = 0
    txtfieldName.SelLength = Len(txtfieldName.Text)
    txtfieldName.SetFocus
    Exit Sub
  End If
 
  '试着追加字段
  scoretab.Fields.Append fld '有病
  If tjoption = 0 Then
  Set fenrecord = scoretab.OpenRecordset
  fenrecord.MoveFirst
  fenrecord.Edit
  fenrecord.Fields(fld.Name).Value = xishuS
  fenrecord.Update
  fenrecord.Close
  End If
  '一定已经成功了，所以...
  '在列表中添加这一项
  lstFields.AddItem fld.Name
  '使新项目开始工作
  lstFields.ListIndex = lstFields.NewIndex
  
  Combo1.Text = vbNullString
  txtfieldName = vbNullString
  OpZU.Value = False
  OpFU.Value = False
  
  Exit Sub
'==============================

show1:
If Err.Number = 3125 Then
    MSG = "请输入科目名！"
    style = vbOKCancel + vbInformation
  If MsgBox(MSG, style, TiShi) = vbOK Then
  txtfieldName.SetFocus
  Exit Sub
  End If
Else
  Beep
 MsgBox "操作有误，请重来！"
End If

End Sub
Private Sub CmdLuRu_Click()

Worktype = 4 '添加了新课程
FrmPutIn.Show
Combo1.Text = vbNullString
txtfieldName.Text = " "

End Sub




'=================================
Private Sub txtTableName_LostFocus()
 On Error GoTo TBNErr
  
   '如果用户改变名称，就改变它
  
  If scoretab.Name <> txtTableName.Text Then
    If Len(txtTableName.Text) > 0 Then  '(And gsDataType = gsMSACCESS Then0
      '查找并为表窗体列表中的项目更名
      scoretab.Name = txtTableName.Text
      'mbTableNameChanged = True
    End If
  End If
  Exit Sub
TBNErr:
  If Err.Number = 91 Then
    Beep
    MsgBox "请按正确步骤操作"
    Else
    Beep
 MsgBox "操作有误，请重来！"
 Unload frmTblStruct
  End If
End Sub

'====================
'以下后加
'=======================