Image图片控件存取access数据库图片问题

24555

各位老师，小的做一个档案录入的窗件，但是没有接触过图片控件，麻烦各位帮我看下文件功能如何实现。谢谢各位了

zhaogang1960

再插入一个按钮导入相片：

1. Dim strFile
   
2. 
   
3. Private Sub CommandButton3_Click() '打开相片
   
4.     strFile = Application.GetOpenFilename(FileFilter:="图像文件(*.jpg), *.jpg")
   
5.     If strFile = False Then Exit Sub
   
6.     Image1.Picture = LoadPicture(strFile)
   
7.     Image1.PictureSizeMode = 1
   
8. End Sub
   

复制代码

zhaogang1960

1. Private Sub CommandButton1_Click() '保存相片
   
2. '引用Microsoft ActiveX Data Objects 2.x Library
   
3.     If strFile = False Or TextBox1.Text = "" Then Exit Sub
   
4.     Dim cnn As New ADODB.Connection
   
5.     Dim rs As New ADODB.Recordset
   
6.     Dim srm As New ADODB.Stream
   
7.     On Error GoTo ErrMsg
   
8.     cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\档案.mdb"
   
9.     srm.Mode = adModeReadWrite
   
10.     srm.Type = adTypeBinary
    
11.     srm.Open
    
12.     srm.LoadFromFile strFile
    
13.     SQL = "select * from 档案 where 编号='" & TextBox1.Text & "'"
    
14.     rs.Open SQL, cnn, adOpenDynamic, adLockOptimistic
    
15.     If rs.RecordCount = 0 Then rs.AddNew Else rs.Fields("编号").Value = TextBox1.Text
    
16.     rs.Fields("相片").Value = srm.Read()
    
17.     rs.Update
    
18.     MsgBox "相片已存入数据库", vbInformation
    
19.     Set rs = Nothing
    
20.     rs.Close
    
21.     Set srm = Nothing
    
22.     Set cnn = Nothing
    
23.     cnn.Close
    
24.     Exit Sub
    
25. ErrMsg:
    
26.     MsgBox Err.Description, , "错误报告"
    
27. End Sub
    

复制代码

zhaogang1960

1. 
   
2. Private Sub CommandButton2_Click() '查询相片
   
3. '引用Microsoft ActiveX Data Objects 2.x Library
   
4.     If TextBox1.Text = "" Then Exit Sub
   
5.     Dim cnn As New ADODB.Connection
   
6.     Dim rs As New ADODB.Recordset
   
7. '    On Error GoTo ErrMsg
   
8.     cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\档案.mdb"
   
9.     Set srm = New ADODB.Stream
   
10.     srm.Mode = adModeReadWrite
    
11.     srm.Type = adTypeBinary
    
12.     srm.Open
    
13.     SQL = "select * from 档案 where 编号='" & TextBox1.Text & "'"
    
14.     rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    
15.     If rs.RecordCount Then
    
16.         srm.Write (rs.Fields("相片").Value)
    
17.         srm.SaveToFile ThisWorkbook.Path & "" & "1.jpg", adSaveCreateOverWrite
    
18.         Image2.Picture = LoadPicture(ThisWorkbook.Path & "" & "1.jpg")
    
19.         Image2.PictureSizeMode = 1
    
20.     End If
    
21.     rs.Close
    
22.     Set rs = Nothing
    
23.     Set srm = Nothing
    
24.     cnn.Close
    
25.     Set cnn = Nothing
    
26.     Exit Sub
    
27. ErrMsg:
    
28.     MsgBox Err.Description, , "错误报告"
    
29. End Sub
    
30. 
    
31. Private Sub UserForm_Terminate() '退出窗体时删除临时图片
    
32.     On Error Resume Next
    
33.     Kill ThisWorkbook.Path & "\1.jpg"
    
34. End Sub
    

复制代码

zhaogang1960

请看附件
新建文件夹.rar (52.39 KB, 下载次数: 279)

2013-12-4 12:36 上传

点击文件名下载附件

24555

谢谢版主！还给了一个实例！我看了附件，不知道为什么，保存图片时总是提示错误信息，不清楚为什么，还有，如果查询相片时能否先清除之前查询到的图片，谢谢了（错误报告：bof 或eof 中有一个是“真”，或者当前的记录已被删除，所需的操作要求一个当前的记录）

zhaogang1960

24555 发表于 2013-12-4 11:03
谢谢版主！还给了一个实例！我看了附件，不知道为什么，保存图片时总是提示错误信息，不清楚为什么，还有， ...

按照下图引用Microsoft ActiveX Data Objects 2.x Library

24555

查看了引用，是引用的了，我看了一下，如果编号在数据库是存在记录的，就可以存入相片（即修改了原有编号的相片），可能是我的表述有问题，我是想增加数据，即加入新的编号、相片，应该怎么改

zhaogang1960

24555 发表于 2013-12-4 12:03
查看了引用，是引用的了，我看了一下，如果编号在数据库是存在记录的，就可以存入相片（即修改了原有编号的 ...

是有点问题，修改如下：

1. Private Sub CommandButton1_Click() '保存相片
   
2. '引用Microsoft ActiveX Data Objects 2.x Library
   
3.     If strFile = False Or TextBox1.Text = "" Then Exit Sub
   
4.     Dim cnn As New ADODB.Connection
   
5.     Dim rs As New ADODB.Recordset
   
6.     Dim srm As New ADODB.Stream
   
7.     On Error GoTo ErrMsg
   
8.     cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\档案.mdb"
   
9.     srm.Mode = adModeReadWrite
   
10.     srm.Type = adTypeBinary
    
11.     srm.Open
    
12.     srm.LoadFromFile strFile
    
13.     SQL = "select * from 档案 where 编号='" & TextBox1.Text & "'"
    
14.     rs.Open SQL, cnn, adOpenDynamic, adLockOptimistic
    
15.     If rs.RecordCount <= 0 Then
    
16.         rs.AddNew
    
17.         rs.Fields("编号").Value = TextBox1.Text
    
18.     End If
    
19.     rs.Fields("相片").Value = srm.Read()
    
20.     rs.Update
    
21.     MsgBox "相片已存入数据库", vbInformation
    
22.     rs.Close
    
23.     Set rs = Nothing
    
24.     Set srm = Nothing
    
25.     cnn.Close
    
26.     Set cnn = Nothing
    
27.     Exit Sub
    
28. ErrMsg:
    
29.     MsgBox Err.Description, , "错误报告"
    
30. End Sub

复制代码

zhaogang1960

请测试附件
新建文件夹.rar (52.39 KB, 下载次数: 448)

2013-12-4 12:37 上传

点击文件名下载附件