View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Select Range and Find Values ***Maybe Loop?***

Maybe...

Option Explicit
Sub testme()
Dim myPath As String
Dim myRng As Range
Dim myCell As Range
Dim TestStr As String
Dim myPict As Picture
Dim myPictName As String
Dim myRatio As Double

'change to the correct location of the picture files
myPath = "C:\Users\mbramer\Desktop\R_RImages"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

With Worksheets("Sheet1")
.Pictures.Delete 'remove any existing pictures???
Set myRng = .Range("G1", .Cells(.Rows.Count, "G").End(xlUp))

For Each myCell In myRng.Cells
myPictName = myPath & myCell.Value & ".jpg"
TestStr = ""
On Error Resume Next
TestStr = Dir(myPictName)
On Error GoTo 0
If TestStr = "" Then
MsgBox "Pictu " & myPictName & " wasn't found"
Else
Set myPict = .Pictures.Insert(myPictName)
With myCell.Offset(0, 1)
myPict.ShapeRange.LockAspectRatio = msoFalse
myRatio = myPict.Width / myPict.Height
myPict.Top = .Top
myPict.Left = .Left
myPict.Height = .Height
myPict.Width = .Height * myRatio
myPict.Name = "Pict_" & .Address(0, 0)
myPict.ShapeRange.LockAspectRatio = msoTrue
End With
End If
Next myCell
End With
End Sub


=====
It looks in G1:G(lastusedrow) and uses the name in that cell to insert a picture
in column H.

The value in column G shouldn't include the path or the extension. This line
creates the path, filename and extension.

myPictName = myPath & myCell.Value & ".jpg"

If you already have ".jpg" in the cell, you can drop it off this line of code:
myPictName = myPath & myCell.Value




RemyMaza wrote:

I'm trying to insert pics based on values that appear in a cell. I
have this code and I've got it to work by hardcoding values. Since I
have like 500 variables, I'd like to steer clear of hardcoding. What
I need help with is selecting the Column to look in and then finding
the correct value
I know this code doesn't work but it should provide direction to what
I'd like to happen.

Dim CellLoop As Range
Dim CellVal As String
CellLoop = Range("G:G")
CellVal = ActiveCell.FormulaR1C1

'Don't Know how to get this to work
Select Case CellVal in CellLoop
Case 1
InsertPicture "C:\Users\mbramer\Desktop\R_RImages\1.jpg",
_
ActiveCell.Offset(0, -2), True, True
Case 2
InsertPicture "C:\Users\mbramer\Desktop\R_RImages\2.jpg",
_
ActiveCell.Offset(0, -2), True, True
Case Else
MsgBox ("Wrong Values")
End Select

Thanks for your help!
Regards,
Matt


--

Dave Peterson