Adding picture

[Jess]

How can I insert a picture into an excel sheet so that its center floats
over a given cell? My picture in an Access table. Excel should call Access,
retrieve the picture, and insert it.

Can anybody post an example?

Thanks

 

[Tim Williams]

I don't have the right version of access to test this, but should be close.
Need to add a reference to ADO in the Excel VB project.

Tim



Sub Access_Data()

Dim picPath As String
Dim oStream As New ADODB.Stream
Dim conn As New ADODB.Connection
Dim rst As ADODB.Recordset
Dim strPath As String
Dim sql As String
Dim rngDest As Range

Set rngDest = ActiveSheet.Range("D3")
sql = "select pic from tblPics where id=1"

strPath = ThisWorkbook.Path & "\Pics.mdb"

conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & strPath & ";"
conn.CursorLocation = adUseClient

Set rst = conn.Execute(sql)
If Not rst.EOF Then

picPath = ThisWorkbook.Path & "\temp.jpg"

oStream.Type = adTypeBinary
oStream.Open
oStream.Write rst.Fields("pic").Value
oStream.SaveToFile picPath, adSaveCreateOverWrite
oStream.Close

rngDest.Parent.Pictures.Insert(picPath).Select
With Selection
.ShapeRange.Top = rngDest.Top
.ShapeRange.Left = rngDest.Left
End With

End If

rst.Close
conn.Close

End Sub