PDA

View Full Version : Define variable from cell value, append, and embed images.



Adonaioc
09-15-2009, 11:16 AM
I have been tasked with embedding an images that correlates with a name of a part in each row of a spread sheet. example

Part1 - someinfo - (image of part1)
part2 - someinfo - (image of part2)

I'm stuck on how exactly to tell the code which cell to embedd the image in.

i would like to be able to make the value in column A a variable and append the path to the front and the extension to the end, and then use that string as the path to the file to be embedded in column C
I found some code that I thought I could use but it is not working for me.

Any help would be appriciated.

Thanks

Sub ListFiles()
Dim fso As Object
Dim strName As String
Dim strArr(1 To 65536, 1 To 1) As String, i As Long

Const strDir As String = "C:\Pictures"
Const searchTerm As String = "*"

Let strName = Dir$(strDir & "\*" & searchTerm & "*.*")
Do While strName <> vbNullString
Let i = i + 1
Let strArr(i, 1) = strDir & "\" & strName
Let strName = Dir$()
Call InsertPic(strName, i)
Loop
Set fso = CreateObject("Scripting.FileSystemObject")
Call recurseSubFolders(fso.GetFolder(strDir), strArr(), i, searchTerm)
Set fso = Nothing
If i > 0 Then
Range("A1").Resize(i).Value = strArr
End If
End Sub

Private Sub recurseSubFolders(ByRef Folder As Object, _
ByRef strArr() As String, _
ByRef i As Long, _
ByRef searchTerm As String)
Dim SubFolder As Object
Dim strName As String
For Each SubFolder In Folder.SubFolders
Let strName = Dir$(SubFolder.Path & "\*" & searchTerm & "*.xls")
Do While strName <> vbNullString
Let i = i + 1
Let strArr(i, 1) = SubFolder.Path & "\" & strName
Let strName = Dir$()
Loop
Call recurseSubFolders(SubFolder, strArr(), i, searchTerm)
Next
End Sub


Sub InsertPic(Path As String, Location As String)
Dim myPic As Picture
With ActiveSheet.Range("B25")
Set myPic = .Parent.Pictures.Insert("C:\Pictures\EnergyBalls.jpg")
myPic.Top = .Top
myPic.Width = .Width
myPic.Height = .Height
myPic.Left = .Left
myPic.Placement = xlMoveAndSize
End With
End Sub

Bob Phillips
09-15-2009, 11:46 AM
In what way is it not working, give us a pointer to where the problem lies.