工作表1.frm

工作报表的源程序内容

      AddRecord = False         '将窗体该成原始状态
      LookupRecord              '重新排序&搜索添加记录
    
    
ElseIf ModifyRecord = True Then '窗体在修改状态？
    On Error GoTo SaveAdd_ModifyError
       BeginTrans     '更改开始
          rs1.Edit     '修改目前记录
          WriteRecord  '将窗体显示登录到记录上
          rs1.Update
       CommitTrans     '更改结束
          ModifyRecord = False    '将窗体状态该成原始状态
    
End If





Exit Sub

SaveAdd_ModifyError:
  Rollback
  MsgBox Err.Description
  Exit Sub
  
CommandError:
  MsgBox Err.Description
    
       





End Sub

Private Sub Command3_Click()    '查找


Picture1.Picture = LoadPicture()

Picture1.Visible = False

MonthView1.Visible = True





End Sub

Private Sub Command4_Click()   '退出

End



End Sub

Private Sub Command5_Click()   '修改

On Error GoTo CommandError

Picture1.Visible = True

Picture1.Picture = LoadPicture(App.Path & "\美眉3.jpg")




Combo3.SetFocus          '将输入焦点至文本框text1(0)

ModifyRecord = True        '目前窗体在修改状态

Exit Sub

CommandError:

   MsgBox Err.Descri

End Sub

Private Sub Command6_Click()   '删除

On Error GoTo DelError

Dim d As Integer
                              '创建删除窗口
d = MsgBox("确认要删除记录吗？", vbQuestion + vbYesNo, "删除记录")

  If d = vbYes Then    '操作者是否按下“是”按钮
  
     BeginTrans                        '更改开始
         rs1.Delete                      '删除记录
     CommitTrans                       '更改结束
     
    rs1.MoveNext                      '移至下一记录
    
    If rs1.RecordCount > 0 Then       '是否有记录
    
       If rs1.BOF Then               '是否记录指针指至末端
          rs1.MoveLast               '移至最后
       End If
       DisplayRecord                 '显示记录内容
    Else
      rs1.AddNew                     '增加一组空白记录
      ClearDisplay                   '清除窗体显示
   
   
    End If
    
End If

  
                      

Exit Sub
DelError:
        Rollback           '回复更改
        
        MsgBox Err.Description




End Sub

Private Sub Command7_Click()       '取消

AddRecord = False      '目前不是在添加状态
ModifyRecord = False  '目前窗体不是在修改状态
                                           'Initial_button             '按钮原始模式
On Error GoTo CommandError

AddRecord = False        '修改“添加”状态标识

If rs1.RecordCount > 0 Then
   DisplayRecord
Else
   ClearDisplay
End If

Exit Sub

CommandError:
  
  MsgBox Err.Description
  





End Sub


Private Sub Command8_Click()

Form1.Refresh

End Sub

Private Sub DTPicker1_Change()



DTPicker1.Value = Format(DTPicker1.Value, "YYYY-MM-DD")

Combo2.Text = Format(DTPicker1.Value, "aaaa")

 
  
End Sub

Private Sub exit_Click()

End


End Sub

Private Sub Form_Load()

 On Error GoTo loaderr
                                    '打开数据库
                                    
 Set db = OpenDatabase(App.Path & "\db8.mdb", False, False)  '数据库的位置需要在默认系统盘上
    

    
Dim sql As String

                         '打开学籍表
sql = "SELECT 工作报告1.* FROM 工作报告1 ORDER BY 工作报告1.工作日期"     '选取数据记录　　ＦＲＯＭ

Set rs1 = db.OpenRecordset(sql, dbOpenDynaset)          '代表创建有SELECT命令字符串所要选取的数据记录成DYNASET数据记录形式，
                                                        '　　　创建的结果设置给Recordset变量rs1.SET 对象变量rs1=数据库变量db.openRecordset(来源，种类）
                              '是否有记录
If rs1.RecordCount > 0 Then

    DisplayRecord          '显示记录数据内容
    
Else

    MsgBox "目前没有任何学生的学籍数据", vbExclamation + vbOKOnly, ""
    
    ClearDisplay       '清除画面显示
    
    rs1.AddNew          '增加空白记录
    
End If

AddRecord = False     '目前不在添加状态

ModifyRecord = False    '目前不在修改状态

MonthView1.Visible = False

Picture1.Picture = LoadPicture(App.Path & "\美眉4.jpg")




 



Exit Sub

loaderr:

    MsgBox Err.Description
    




End Sub



Public Sub DisplayRecord()



 Dim i As Integer
 
 
        
     If Not IsNull(rs1.Fields(i)) Then         'isnull()函数判断是否为空白内容的函数
     
                   Combo3.Text = rs1.Fields(0)      '姓名字段
                   
                   Combo1.Text = rs1.Fields(1)   '部门字段
                   
                   DTPicker1.Value = rs1.Fields(2)   '工作日期字段
                   
                   Combo2.Text = rs1.Fields(3)   '星期字段
     
                   Text1.Text = rs1.Fields(4)      '工作记录字段
                    
                    
                    
                   
                    
                    
        Else
                    Combo3.Text = ""
     
                    Text1.Text = ""
        
                    Combo1.Text = ""
                    
                    Combo2.Text = ""
                    
                    DTPicker1.Value = ""
     End If

 


End Sub

Public Sub ClearDisplay()

Dim i As Integer


   Combo3.Text = "赵玉周"
     
   Text1.Text = ""
   
   Combo1.Text = "工程部"
   
   Combo2.Text = ""
   
   DTPicker1.Value = Date



End Sub


Public Sub WriteRecord()


'Dim i As Integer


       ' If Text1.Text <> "" Then              '如果文本框有数句
        
            rs1.Fields(0) = Combo3.Text
            
            rs1.Fields(1) = Combo1.Text
            
            rs1.Fields(2) = DTPicker1.Value
            
            rs1.Fields(3) = Combo2.Text
            
            rs1.Fields(4) = Text1.Text
            
            
       ' End If
   
     





End Sub

Public Sub LookupRecord()

Dim s As String

rs1.Requery     '重新排序

s = "工作日期=" & "'" & "'"
If s <> "" Then '搜索添加记录
   rs1.FindFirst s
End If



End Sub

Private Sub MonthView1_DateClick(ByVal DateClicked As Date)


DTPicker1.Value = Format(MonthView1.Value, "YYYY-MM-DD")


On Error GoTo CommandError

Dim num As String


 num = DTPicker1.Value
 

 

If num <> "" Then  '有输入数据

    num = "工作日期=" & "'" & num & "'"    '搜索字符串
                             
    rs1.FindFirst num      '搜索
    

    If Not rs1.NoMatch Then       '找到
        DisplayRecord             '显示记录数据
    Else
        MsgBox "没有工作记录", vbOKOnly + vbExclamation, ""
    End If
    
    
End If







Exit Sub                      '搜索到之后退出正常程序




CommandError:
  MsgBox Err.Description
  


End Sub