• The forum (and all other resources in Chandoo.org) will be under maintenance and will be unavailable for a maximum of two hours on the first week of October 2023. The exact date, time and duration of the maintenance are subject to change. We regret the inconvience it may cause.

  • 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

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
 
Belleke said:
How can i change this code so it works for jpg and gif?
Click to expand...
Marc L said:
[…] or just duplicate the codelines block for the second extension …
Click to expand...
Marc L said:
you should test one extension and if it not matches then test the second (like gif after jpg).
Click to expand...
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 …
Click to expand...
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
 
Marc L said:
As you must check each extension so use a variable for each or just duplicate the codelines block for the second extension …
Click to expand...
Use the variable as the extension in your block or just duplicate the block for each extension …​
​
Another For Each sample :​

Wildcard Sheet Name Dynamic

Hi, I posted in Questions but I think this more applicable to the VBA section as I think it is very possible it will be needed. I have been taken to the cleaners over this sheet for the past couple days. What I am trying to do is create a sum across with all sheet that have "Resource" in the...
chandoo.org
 
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
 
You must log in or register to reply here.
Back
Top