Hi James
Glad to help.
The following assumes your "jpg" numbers are in the range G5 to G14 and the
corresponding pictures are to be placed in cells B16 to K16.
Sub test()
Application.ScreenUpdating = False
Dim i As Integer, p As Picture, r As Range, c As Range, ii As Integer
ii = 1
Set r = ActiveSheet.Range("G5:G14")
ActiveSheet.DrawingObjects.Delete
For Each c In r
ii = ii + 1
If c <> "" Then
With Application.FileSearch
..NewSearch
..LookIn = "c:\pics"
..SearchSubFolders = False
..Filename = "*" & c & ".jpg"
..Execute
For i = 1 To .FoundFiles.Count
With ActiveSheet
Set p = .Pictures.Insert(Application.FileSearch.FoundFiles(i))
..DrawingObjects(p.Name).Left = .Columns(ii).Left
..DrawingObjects(p.Name).Top = .Rows(16).Top
..DrawingObjects(p.Name).Width = .Columns(ii + 1).Left - .Columns(ii).Left
..DrawingObjects(p.Name).Height = .Rows(17).Top - .Rows(16).Top
..DrawingObjects(p.Name).Placement = xlMoveAndSize
..DrawingObjects(p.Name).PrintObject = True
End With
Exit For
Next i
End With
End If
Next c
Application.ScreenUpdating = True
End Sub
--
XL2002
Regards
William
(e-mail address removed)
| Hi William,
|
| My response to you directly was in error, my apologies to you and the
group.
|
| I am so happy with the code you did for me, it works wonderfully. I only
| need to adjust one last thing and I could use your help.
|
| I changed the range to reflect G5:G14 and it locates the images perfectly.
| However the destination of the images will be B16:K16 and I haven't quite
| figured out how to accomplish this.
|
| If there is a number in G5 for example then the image will be placed in
B16.
| A number in G6 will place the image in C16....and so on. Numbers in the
"G"
| column will result in images being placed in the 16th row.
|
| Thank you so much,
|
| James Norton
|
|
| | > James
| >
| > Please post to the ng rather than me directly so others can follow the
| > thread.
| >
| > I'm assuming you have a list of what you term "numeric lines" in A1 to
A10
| > and you want the corresponding picture in B1 to B10.
| >
| > Sub test()
| > Application.ScreenUpdating = False
| > Dim i As Integer, p As Picture, r As Range, c As Range, ii As Integer
| > ii = 0
| > Set r = ActiveSheet.Range("A1:A10")
| > ActiveSheet.DrawingObjects.Delete
| > For Each c In r
| > ii = ii + 1
| > If c <> "" Then
| > With Application.FileSearch
| > .NewSearch
| > .LookIn = "c:\pics"
| > .SearchSubFolders = False
| > .Filename = "*" & c & ".jpg"
| > .Execute
| > For i = 1 To .FoundFiles.Count
| > With ActiveSheet
| > Set p = .Pictures.Insert(Application.FileSearch.FoundFiles(i))
| > .DrawingObjects(p.Name).Left = .Columns("B").Left
| > .DrawingObjects(p.Name).Top = .Rows(ii).Top
| > .DrawingObjects(p.Name).Width = .Columns("C").Left - .Columns("B").Left
| > .DrawingObjects(p.Name).Height = .Rows(ii + 1).Top - .Rows(ii).Top
| > .DrawingObjects(p.Name).Placement = xlMoveAndSize
| > .DrawingObjects(p.Name).PrintObject = True
| > End With
| > Exit For
| > Next i
| > End With
| > End If
| > Next c
| > Application.ScreenUpdating = True
| > End Sub
| >
| >
| > --
| > XL2002
| > Regards
| >
| > William
| >
| > (e-mail address removed)
| >
| > | > | Hi James
| > |
| > | I don't understand what you mean by
| > | ".....i.e. A1 numeric value will have the image placed in 11A
| > | A2 numberic value will have the image placed in 11B etc. etc."
| > | Please clarify.
| > |
| > | --
| > | XL2002
| > | Regards
| > |
| > | William
| > |
| > | (e-mail address removed)
| > |
| > | | > | | I should have mentioned this earlier also but I just noticed it.
There
| > is
| > | a
| > | | maximum possibility of 10 numeric lines, therefore there is the
| > | possibility
| > | | of 10 images per sheet. All these pictures will have a specific cell
| > they
| > | | will be placed into based on the originating cell.
| > | |
| > | | i.e. A1 numeric value will have the image placed in 11A
| > | | A2 numberic value will have the image placed in 11B etc. etc.
| > | |
| > | | Thanks again for your help.
| > | |
| > | | James Norton
| > | | | > | | > Hi James
| > | | >
| > | | > Try this code
| > | | >
| > | | > Sub test()
| > | | > Dim s As String, i As Integer
| > | | > s = "c:\pics"
| > | | > ActiveSheet.Range("A2").Select
| > | | > With Application.FileSearch
| > | | > .NewSearch
| > | | > .LookIn = s
| > | | > .SearchSubFolders = False
| > | | > .Filename = "*" & ActiveSheet.Range("A1") & ".jpg"
| > | | > .MatchTextExactly = True
| > | | > .Execute
| > | | > For i = 1 To .FoundFiles.Count
| > | | > ActiveSheet.DrawingObjects.Delete
| > | | > ActiveSheet.Pictures.Insert (.FoundFiles(i))
| > | | > Exit For
| > | | > Next i
| > | | > End With
| > | | > End Sub
| > | | >
| > | | >
| > | | > --
| > | | > XL2002
| > | | > Regards
| > | | >
| > | | > William
| > | | >
| > | | > (e-mail address removed)
| > | | >
| > | | > | > | | > | Hi there,
| > | | > |
| > | | > | I am trying to figure out how I can insert a picture (jpg) based
| > on
| > a
| > | | > number
| > | | > | in another box.
| > | | > |
| > | | > | I have a database of over 1500 pictures at a pharmacy of the
| > different
| > | | > meds.
| > | | > | The file name is always a DIN number and is unique to that
| > medication
| > | | > (i.e.
| > | | > | 0982_567252567.jpg). I don't know what the first 4 digits and
| > | underscore
| > | | > are
| > | | > | for and I would like to be able to ignore that.
| > | | > |
| > | | > | So if I enter drug number 567252567 in box A1 - it will look for
| > that
| > | | > string
| > | | > | (567252567) in c:\pics\ and insert that jpg (0982_567252567.jpg)
| > into
| > | | A2.
| > | | > |
| > | | > | The good thing is that the number regardless of what is in front
| > of
| > it
| > | | > will
| > | | > | be unique.
| > | | > |
| > | | > | The point of doing this is that we print out drug information
for
| > | | seniors.
| > | | > | When we type in the DIN number it will insert a picture of the
| > pill
| > | they
| > | | > | need to take preventing medication errors.
| > | | > |
| > | | > | Any help is most appreciated as always,
| > | | > |
| > | | > | Best regards,
| > | | > |
| > | | > | James Norton
| > | | > |
| > | | > |
| > | | >
| > | | >
| > | |
| > | |
| > |
| > |
| >
| >
|
|
|
|
|
