使用treeview樹形控件生成目錄

Private Sub Form_Load()

Call 生成目錄

End Sub

Sub 生成目錄()

Dim 節(jié)點(diǎn)索引

Set 節(jié)點(diǎn)索引 = 目錄.Nodes.Add(, , "A", "目錄")

節(jié)點(diǎn)索引.Sorted = True

Dim 目錄rs As Recordset

Set 目錄rs = CurrentDb.OpenRecordset("一級(jí)表", dbOpenTable)

Do While 目錄rs.EOF = False

? ? Set 節(jié)點(diǎn)索引 = 目錄.Nodes.Add("A", tvwChild, "B" & 目錄rs!一級(jí)ID, 目錄rs!一級(jí)名稱)

? ? 節(jié)點(diǎn)索引.Sorted = True

目錄rs.MoveNext

Loop

目錄rs.Close

Set 目錄rs = CurrentDb.OpenRecordset("二級(jí)表", dbOpenTable)

Do While 目錄rs.EOF = False

? ? Set 節(jié)點(diǎn)索引 = 目錄.Nodes.Add("B" & 目錄rs!一級(jí)ID, tvwChild, "C" & 目錄rs!二級(jí)ID, 目錄rs!二級(jí)名稱)

? ? 節(jié)點(diǎn)索引.Sorted = True

目錄rs.MoveNext

Loop

目錄rs.Close

Set 目錄rs = CurrentDb.OpenRecordset("三級(jí)表", dbOpenTable)

Do While 目錄rs.EOF = False

? ? Set 節(jié)點(diǎn)索引 = 目錄.Nodes.Add("C" & 目錄rs!二級(jí)ID, tvwChild, "D" & 目錄rs!三級(jí)ID, 目錄rs!三級(jí)名稱)

? ? 節(jié)點(diǎn)索引.Sorted = True

目錄rs.MoveNext

Loop

目錄rs.Close

目錄.Nodes(1).Expanded = True

End Sub

Private Sub 目錄_NodeClick(ByVal Node As Object)

If Node.Text = "目錄" Or Node.Key Like "A*" Or Node.Key Like "B*" Or Node.Key Like "C*" Then

Else

MsgBox Node.Text

End If

End Sub

使用VBA代碼引用外部表

Private Sub Form_Close()

Call deltable

End Sub

Private Sub Form_Load()

Call deltable

Call linktable

Me.數(shù)據(jù)表子窗體.SourceObject = "銷售數(shù)據(jù)表"

End Sub

Public Sub linktable()

Dim dbImport As String

dbImport = CurrentProject.Path & "\data.accdb"

Dim sPassword As String

sPassword = "abc123"

Dim DB As DAO.Database

Set DB = DBEngine.OpenDatabase(Name:=dbImport, Options:=False, ReadOnly:=False, Connect:=";PWD=" & sPassword)

DoCmd.TransferDatabase acLink, "Microsoft Access", dbImport, acTable, "銷售數(shù)據(jù)表", "銷售數(shù)據(jù)表"

? ? DB.Close

? ? Set DB = Nothing

End Sub

Public Sub deltable()

On Error Resume Next

Dim deltsql As String

DoCmd.SetWarnings (False)

deltsql = "Drop TABLE 銷售數(shù)據(jù)表"

DoCmd.RunSQL deltsql

End Sub

使用操作查詢更新記錄

學(xué)生成績管理

Private Sub Command更新_Click()

DoCmd.SetWarnings (False)

Dim update_sql As String

update_sql = "Update 學(xué)生成績表 Set 考試日期=#" & 考試日期 & "#,姓名='" & 姓名 & "',科目='" & 科目 & "',分?jǐn)?shù)=" & 分?jǐn)?shù) & "? Where? 成績ID=" & 成績ID

DoCmd.RunSQL update_sql

MsgBox "更新成功"

End Sub

Private Sub Command刪除_Click()

If MsgBox("是否刪除該記錄", vbOKCancel) <> vbOK Then

Exit Sub

End If

DoCmd.SetWarnings (False)

Dim del_sql As String

del_sql = "Delete From 學(xué)生成績表 Where? 成績ID= " & Me.成績ID

DoCmd.RunSQL del_sql

MsgBox "刪除成功"

DoCmd.Close acForm, Me.Name

End Sub

Private Sub Form_Close()

On Error Resume Next

Forms("學(xué)生成績列表").Form.數(shù)據(jù)表子窗體.Requery

End Sub

Private Sub Form_Load()

Dim search_rs As DAO.Recordset

Dim search_sql As String

search_sql = "Select * From 學(xué)生成績表 Where 成績ID= " & 成績IDnum

Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset)

If search_rs.EOF = False Then

成績ID.Value = search_rs!成績ID.Value

考試日期.Value = search_rs!考試日期.Value

姓名.Value = search_rs!姓名.Value

科目.Value = search_rs!科目.Value

分?jǐn)?shù).Value = search_rs!分?jǐn)?shù).Value

End If

search_rs.Close

Set search_rs = Nothing

End Sub

學(xué)生成績列表

Private Sub Command清除_Click()

考試日期.Value = ""

姓名.Value = ""

科目.Value = ""

分?jǐn)?shù).Value = ""

End Sub

Private Sub Command添加_Click()

On Error GoTo 添加失敗錯(cuò)誤

If 考試日期 = "" Or IsNull(考試日期) = True Then

MsgBox "考試日期值為空！"

Exit Sub

End If

If 姓名 = "" Or IsNull(姓名) = True Then

MsgBox "姓名值為空！"

Exit Sub

End If

If 科目 = "" Or IsNull(科目) = True Then

MsgBox "科目值為空！"

Exit Sub

End If

If 分?jǐn)?shù) = "" Or IsNull(分?jǐn)?shù)) = True Then

MsgBox "分?jǐn)?shù)值為空！"

Exit Sub

End If

'================================================================

Dim add_rs As DAO.Recordset

Set add_rs = CurrentDb.OpenRecordset("學(xué)生成績表", dbOpenTable)

With add_rs

.AddNew

!考試日期.Value = 考試日期.Value

!姓名.Value = 姓名.Value

!科目.Value = 科目.Value

!分?jǐn)?shù).Value = 分?jǐn)?shù).Value

.Update

.Close

End With

Set add_rs = Nothing

?'================================================================

MsgBox "添加成功！"

Me.數(shù)據(jù)表子窗體.Requery

Exit Sub

添加失敗錯(cuò)誤:

MsgBox Err.Description

End Sub

學(xué)生成績數(shù)據(jù)表

Private Sub Form_BeforeUpdate(Cancel As Integer)

On Error GoTo 數(shù)據(jù)更新前提醒_Err

? ? If (MsgBox("是否保存對(duì)記錄的修改", 1, "修改記錄提醒") = 1) Then

? ? Else

? ? ? ? DoCmd.RunCommand acCmdUndo

? ? End If

數(shù)據(jù)更新前提醒_Exit:

? ? Exit Sub

數(shù)據(jù)更新前提醒_Err:

? ? MsgBox Error$

? ? Resume 數(shù)據(jù)更新前提醒_Exit

End Sub

Private Sub 成績ID_DblClick(Cancel As Integer)

成績IDnum = Me.成績ID

DoCmd.OpenForm "學(xué)生成績管理", acNormal

End Sub

模塊1

Public 成績IDnum As Long