• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

using multiple image extensions

Belleke

Well-Known Member
How can i change this code so it works for jpg and gif?
Code:
If Dir(Path & Cell & ".jpg") <> "" Then
            With .Pictures.Insert(Path & Cell & ".jpg")
Thanks in advance
 
As you must check each extension so use a variable for each or just duplicate the codelines block for the second extension …​
 
Not sure of what means your last post but you should obviously be more patient, I could be offline for a day or more …​
Just reading VBA help its Dir function works only with a single extension​
so you should test one extension and if it not matches then test the second (like gif after jpg).​
 
This is the complete code.
I want to expand this code so I can use different extensions.
Jpg, Gif,Png
Any body an idee?
Code:
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).
So easy for any good enough reader :​
Code:
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
Do you like it ? So thanks to click on bottom right Like !​
 
Thanks for your reply. I was wondering if there is another way, shorter not a code block for every extension,
Thanks
 
Yes as I wrote you can use a For Each variable on an extensions array …
Yes you wrote it, the only problem is how to do it,that is the reason why I asked the question.
 
Like in VBA help - a must read ! - a 'For Each' demonstration :​
Code:
Sub DemoForEach()
         Dim V
    For Each V In Array(".gif", ".jpg")
        Debug.Print V
    Next
End Sub
 
As you must check each extension so use a variable for each or just duplicate the codelines block for the second extension …
Use the variable as the extension in your block or just duplicate the block for each extension …​
Another For Each sample :​
 
For each is not the problem, how to do it with the pics instead of cells,I don't want to use the blocks for every extention.
An example of a for each in a function doen't help at aal.
 
So just incorporate your block in a For Each loop and replace within your block each hardcoded extension with the For Each variable …​
As examples always help for those well reading them !​
 
Now I have this.
Code:
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
I simply don't get it.
 
According to the piece you shared nothing seems wrong​
so just check if the execution enters the If block and if not that means the bad is within Path & Cell …​
 
No go.:(
The names of the pictures are in Column M with extension like chandoo.jpg
this is the code
Code:
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
 
Create a procedure to just list the matching files - if any - in the VBE Immediate window for example …​
 
Like any VBA beginner must check if any matching file :​
Code:
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
 
Back
Top