Sub belle()
Dim Cell As Range, Path As String
Path = "C:\Test\"
With Sheets("Sheet1")
For Each Cell In .Range("M2:M" & .Cells(.Rows.Count, 13).End(xlUp).Row)
If Dir(Path & Cell & ".jpg") <> "" Then
With .Pictures.Insert(Path & Cell & ".jpg")
.ShapeRange.LockAspectRatio = msoFalse
.Left = Cell.Offset(, 1).Left: .Top = Cell.Offset(, 1).Top
.Width = Cell.Offset(, 1).Width: .Height = Cell.Offset(, 1).Height
End With
End If
Next Cell
End With
End Sub
How can i change this code so it works for jpg and gif?
[…] or just duplicate the codelines block for the second extension …
you should test one extension and if it not matches then test the second (like gif after jpg).
Sub Demo1()
Dim Path$, Cell As Range
Path = "C:\Test\"
With Sheets("Sheet1")
For Each Cell In .Range("M2", .Cells(.Rows.Count, 13).End(xlUp))
If Dir(Path & Cell & ".jpg") > "" Then
With .Pictures.Insert(Path & Cell & ".jpg")
.ShapeRange.LockAspectRatio = msoFalse ' no such a good idea …
.Left = Cell.Offset(, 1).Left
.Top = Cell.Offset(, 1).Top
.Width = Cell.Offset(, 1).Width
.Height = Cell.Offset(, 1).Height
End With
ElseIf Dir(Path & Cell & ".gif") > "" Then
With .Pictures.Insert(Path & Cell & ".gif")
.ShapeRange.LockAspectRatio = msoFalse
.Left = Cell.Offset(, 1).Left
.Top = Cell.Offset(, 1).Top
.Width = Cell.Offset(, 1).Width
.Height = Cell.Offset(, 1).Height
End With
End If
Next
End With
End Sub
Yes you wrote it, the only problem is how to do it,that is the reason why I asked the question.Yes as I wrote you can use a For Each variable on an extensions array …
As you must check each extension so use a variable for each or just duplicate the codelines block for the second extension …
For Each Cell In .Range("M2:M" & .Cells(.Rows.Count, 13).End(xlUp).Row)
For Each pic In Array(".gif", ".jpg")
If Dir(Path & Cell & pic) <> "" Then
With .Pictures.Insert(Path & Cell & pic)
.ShapeRange.LockAspectRatio = msoFalse
.Left = Cell.Offset(, 1).Left: .Top = Cell.Offset(, 1).Top
.Width = Cell.Offset(, 1).Width: .Height = Cell.Offset(, 1).Height
End With
End If
Next pic
Next Cell
Sub belle()
Dim Cell As Range, Path As String
Path = "C:\test\"
With Sheets("test")
For Each Cell In .Range("M2:M" & .Cells(.Rows.Count, 13).End(xlUp).Row)
For Each pic In Array(".gif", ".jpg")
If Dir(Path & Cell & pic) <> "" Then
With .Pictures.Insert(Path & Cell & pic)
.ShapeRange.LockAspectRatio = msoFalse
.Left = Cell.Offset(, 1).Left: .Top = Cell.Offset(, 1).Top
.Width = Cell.Offset(, 1).Width: .Height = Cell.Offset(, 1).Height
End With
End If
Next pic
Next Cell
End With
End Sub
Sub Check1()
Dim Rc As Range, E, F$, L&
With Sheets("test")
For Each Rc In .Range("M2", .Cells(.Rows.Count, 13).End(xlUp))
For Each E In Array(".gif", ".jpg")
F = Dir$("C:\test\" & Rc & E): If F > "" Then L = L + 1: Debug.Print F
Next E, Rc
End With
Debug.Print "Total : "; L
End Sub