一、使用MSHFlexGrid控件实现对ACCESS数据库的数据访问,使用文本框来获得用户输入的数据。
二、问题:
1、如何在当前目录中使用数据库
方法:
保存文本框中的数据
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim Str1 As String
Dim Str2 As String
Dim Str3 As String
Str1 = "Provider=Microsoft.Jet.OLEDB.4.0;"
Str2 = "Data Source=Access_db.mdb;" //这个就会默认当前目录为数据库的目录。用于保存数据。
Str3 = "Jet OLEDB:Database Password="
conn.Open Str1 & Str2 & Str3
strsql = "select * from wzdz where 编号=" & Val(Text4.Text) & ""
rs.Open strsql,conn,3,3
在调用的Adodc1中的connectionString属性中设置为
Provider=Microsoft.Jet.OLEDB.4.0;Data Source=数据库名称;Persist Security Info=False
2、如何实现单元格的复制和粘贴。
OptionExplicit
PrivateSubForm_Load()
WithMe.MSHFlexGrid1
.TextMatrix(2,2)="TEST"
.TextMatrix(2,3)="TEST2"
EndWith
EndSub
'VB实现MSHFlexGrid支持ctrl+c、ctrl+v
'只支持文本,而且只能一格一格复制
'Clipboard对象用于操作剪贴板中的文本和图形它使用户能够复制、剪切和粘贴应用程序中
'的文本和图形。Clipboard.Clear必须在复制之前使用来清除Clipboard对象中的内容
PrivateSubMSHFlexGrid1_KeyDown(KeyCodeAsInteger,ShiftAsInteger)
DimtmptextAsString
IfShift=2Then
SelectCaseKeyCode
CasevbKeyC
Clipboard.Clear
Clipboard.SetTextMSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row,MSHFlexGrid1.Col)
CasevbKeyV
IfClipboard.GetFormat(vbCFText)Then
tmptext=Clipboard.GetText(vbCFText)
MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row,MSHFlexGrid1.Col)=tmptext'Clipboard.GetData()
EndIf
EndSelect
EndIf
EndSub
三、通讯录实例
Private Sub Command1_Click()
Dim sc As Integer
If Text1.Text = "" Or Text3.Text = "" Or Text9.Text = "" Then
'即网站名称、网站地址和网站描述的内容必须填全了才打开数据库连接写入数据
'由于系统数据库设计为“编号”字段采用的是Access的自动编号
'因此在添加记录时不接收编号的数据,由Access自动加编号
MsgBox ("请输入完整的通讯信息")
Else
sc = MsgBox("确实要添加这条记录吗?",vbOKCancel,"提示信息")
If sc = 1 Then
'运行时如果用户点击的是MsgBox提示框的“确定”按钮,返回值是1
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim Str1 As String
Dim Str2 As String
Dim Str3 As String
Str1 = "Provider=Microsoft.Jet.OLEDB.4.0;"
Str2 = "Data Source=Access_db.mdb;"
Str3 = "Jet OLEDB:Database Password="
conn.Open Str1 & Str2 & Str3
strsql = "select * from wzdz"
rs.Open strsql,3
rs.AddNew
rs!姓名 = Text1.Text
rs!家庭电话 = Text2.Text
rs!手机 = Text3.Text
rs!电子邮件 = Text5.Text
rs!QQ = Text6.Text
rs!生日 = Text7.Text
rs!地址 = Text8.Text
rs!爱好 = Text9.Text
rs.Update
rs.Close
conn.Close
Adodc1.Refresh
'刷新数据源,MSHFlexGrid控件会实时刷新显示数据
End If
'以下四条语句的作用是在操作完成后将文本框置空
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
End If
End Sub
Private Sub Command2_Click()
If Not IsNumeric(Text4.Text) Or Val(Text4.Text) = 0 Then
'编号字段是Access的自动编号,为自然数
'因此对text4的内容进行校验,如果不是数值或为0则跳出sub过程
MsgBox "记录号是大于0的自然数,请输入正确的编号!"
Exit Sub
End If
If Text1.Text = "" Then
'对三个文本框的内容进行校验,不接收空值
MsgBox "请输入完整的网站信息!"
Exit Sub
End If
Dim sc As Integer
sc = MsgBox("确实修改这条记录吗?","提示信息")
If sc = 1 Then
'运行时如果用户点击的是MsgBox提示框的“确定”按钮,返回值是1
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim Str1 As String
Dim Str2 As String
Dim Str3 As String
Str1 = "Provider=Microsoft.Jet.OLEDB.4.0;"
Str2 = "Data Source=Access_db.mdb;"
Str3 = "Jet OLEDB:Database Password="
conn.Open Str1 & Str2 & Str3
strsql = "select * from wzdz where 编号=" & Val(Text4.Text) & ""
rs.Open strsql,3
If rs!编号 = Val(Text4.Text) Then
'由于系统数据库使用的是自动编号作为主键
'因此以编号字段的内容作为判断的依据
'如果rs!编号 = Val(Text4.Text)说明数据库中有此记录,
'才会修改其它三个字段的内容
'否则给出“不存在此记录”的提示信息并关闭数据连接
rs!姓名 = Text1.Text
rs!家庭电话 = Text2.Text
rs!手机 = Text3.Text
rs!电子邮件 = Text5.Text
rs!QQ = Text6.Text
rs!生日 = Text7.Text
rs!地址 = Text8.Text
rs!爱好 = Text9.Text
rs.Update
rs.Close
conn.Close
MsgBox ("修改记录成功!")
Adodc1.Refresh '刷新数据源,MSHFlexGrid控件会实时刷新显示数据
Else
MsgBox ("不存在此记录!")
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
rs.Close
conn.Close
Exit Sub
End If
End If
'以下四条语句的作用是在操作完成后将文本框置空
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
End Sub
Private Sub Command3_Click()
If Not IsNumeric(Text4.Text) Or Val(Text4.Text) = 0 Then
'编号字段是Access的自动编号,为自然数
'因此对text4的内容进行校验,如果不是数值或为0则跳出sub过程
MsgBox "编号是大于0的自然数,请输入正确的编号!"
Exit Sub
End If
Dim sc As Integer
sc = MsgBox("确实要删除这个记录吗?","删除确认!")
If sc = 1 Then
'运行时如果用户点击的是MsgBox提示框的“确定”按钮,返回值是1
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim Str1 As String
Dim Str2 As String
Dim Str3 As String
Str1 = "Provider=Microsoft.Jet.OLEDB.4.0;"
Str2 = "Data Source=Access_db.mdb;"
Str3 = "Jet OLEDB:Database Password="
conn.Open Str1 & Str2 & Str3
strsql = "select * from wzdz where 编号=" & Val(Text4.Text) & ""
rs.Open strsql,3
If rs!编号 = Val(Text4.Text) Then
'由于系统数据库使用的是自动编号作为主键
'因此以编号字段的内容作为判断的依据
'如果rs!编号 = Val(Text4.Text)说明数据库中有此记录并进行删除操作
'否则给“不存在此记录”的提示信息并关闭数据连接
rs.Delete
rs.Close
conn.Close
Adodc1.Refresh '刷新数据源,MSHFlexGrid控件会实时刷新显示数据
Else
MsgBox ("不存在此记录!")
Text4.Text = ""
rs.Close
conn.Close
Exit Sub
End If
End If
'以下四条语句的作用是在操作完成后将文本框置空
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
End Sub
Private Sub Command4_Click()
Dim sc As Integer
sc = MsgBox("确实要退出系统吗?","提示信息")
If sc = 1 Then
'运行时如果用户点击的是MsgBox提示框的“确定”按钮,返回值是1
End
End If
End Sub
Private Sub Form_Load()
With Me.MS1
.TextMatrix(2,2) = "TEST"
.TextMatrix(2,3) = "TEST2"
End With
Form1.MS1.ColWidth(0) = 200
Form1.MS1.ColWidth(1) = 700
Form1.MS1.ColWidth(2) = 1200
Form1.MS1.ColWidth(3) = 1200
Form1.MS1.ColWidth(4) = 1650
Form1.MS1.ColWidth(5) = 1100
Form1.MS1.ColWidth(6) = 1100
Form1.MS1.ColWidth(7) = 1600
Form1.MS1.ColWidth(8) = 2800
Form1.Text1.Text = ""
Form1.Text2.Text = ""
Form1.Text3.Text = ""
Form1.Text4.Text = ""
Form1.Text5.Text = ""
Form1.Text6.Text = ""
Form1.Text7.Text = ""
Form1.Text8.Text = ""
Form1.Text9.Text = ""
End Sub
'这个只能一格一格的复制
Private Sub MS1_KeyDown(KeyCode As Integer,Shift As Integer)
Dim tmptext As String
If Shift = 2 Then
Select Case KeyCode
Case vbKeyC
Clipboard.Clear
'Clipboard对象用于操作剪贴板中的文本和图形它使用户能够复制、剪切和粘贴应用程序中
'的文本和图形。Clipboard.Clear必须在复制之前使用来清除Clipboard对象中的内容
Clipboard.SetText MS1.TextMatrix(MS1.Row,MS1.Col) '复制
Case vbKeyV
If Clipboard.GetFormat(vbCFText) Then
tmptext = Clipboard.GetText(vbCFText)
MS1.TextMatrix(MS1.Row,MS1.Col) = tmptext
End If
End Select
End If
End Sub