VBA : Insert Pictures With Multiple Select Picture & Consecutive Placing

[muhammad susanto]

Cross posted
http://www.eileenslounge.com/viewtop...292701#p292701

---

hi expert..

this macro code below working properly to insert picture from a folder with one by one select picture
i want to modified so macro work with criteria:
1. can insert picture from a folder with multiple select picture and insert to multiple cell at once
2. pictures can inserted automatically consecutive/sequentially placing into target cell (target cell are random) with name of file picture are random --> (main option)
3. if point #2 impossible to do it , to insert automatically consecutive can use name of file picture or based on name pictures like e.g. photo1, photo2,photo3, photo4, or whatever name's file picture etc....> (secondary option)
here code

Sub InsertPicture()    Const cBorder As Double = 5     ' << change as required
    Dim vPicture As Variant, pic As Shape
    vPicture = Application.GetOpenFilename("Pictures (*.gif; *.jpg; *.jpeg; *.tif), *.gif; *.jpg; *.jpeg; *.tif", , "Select Picture to Import")
    If vPicture = False Then Exit Sub
   Set pic = ActiveSheet.Shapes.AddPicture(Filename:=vPicture, LinkToFile:=False, SaveWithDocument:=True, _
                Left:=ActiveCell.MergeArea.Left + cBorder, Top:=ActiveCell.MergeArea.Top + cBorder, Width:=-1, Height:=-1)
    With pic
        .LockAspectRatio = False       ' << change as required
         If Not .LockAspectRatio Then
            .Width = ActiveCell.MergeArea.Width - (2 * cBorder)
            .Height = ActiveCell.MergeArea.Height - (2 * cBorder)
        Else
            If .Width >= .Height Then
                .Width = ActiveCell.MergeArea.Width - (2 * cBorder)
            Else
                .Height = ActiveCell.MergeArea.Height - (2 * cBorder)
            End If
        End If
        .Placement = xlMoveAndSize
    End With
    Set pic = Nothing
End Sub

any help, greatly appreciated..
susanto

[DocAElstein]

Hi
I can’t help you with a full solution because I have no experience inserting pictures. (Maybe someone else may help more later)


But I can show you again how we can loop to repeat something for more than one file in a folder


Example
On my desktop, I have a folder, I did give it a name
Picture Example Folder
, its full path and file name is
C:\Users\Elston\Desktop\Picture Example Folder

https://i.postimg.cc/7b8WngcR/Pictur...My-Desktop.jpg
Picture Example Folder on My Desktop.JPG

I have two possibilities
_ 1 One by one select picture. I must do this macro two times

'                                                                                                               https://excelfox.com/forum/showthread.php/2781-VBA-Insert-Pictures-With-Multiple-Select-Picture-amp-Consecutive-Placing   https://bettersolutions.com/vba/files-directories/application-getopen.htm     https://docs.microsoft.com/de-de/office/vba/api/excel.application.getopenfilename
Sub DoItTwoTimesForTwoFiles()
Dim vPicture As Variant
' let vPicture = Application.GetOpenFilename("Pictures (*.gif; *.jpg; *.jpeg; *.tif), *.gif; *.jpg; *.jpeg; *.tif", , "Select Picture to Import")
' Let vPicture = Application.GetOpenFilename(FileFilter:="Pictures (*.gif; *.jpg; *.jpeg; *.tif), *.gif; *.jpg; *.jpeg; *.tif", FilterIndex:=1, Title:="Select Picture to Import")
Let vPicture = Application.GetOpenFilename(FileFilter:="Pictures gif ,*.gif," & "Pictures jpg ,*.jpg," & "Pictures jpeg ,*.jpeg," & "Pictures tif ,*.tif,", FilterIndex:=2, Title:="Select Picture to Import", MultiSelect:=False)
    If vPicture = False Then Exit Sub
MsgBox prompt:="The picture, you did selected it, the full path and file name it is " & vPicture
End Sub

_ 2 I can do this macro just once and it will select all file

Sub DoItLoopy()
Dim Path As String
 Let Path = "C:\Users\Elston\Desktop\Picture Example Folder" '  CHANGE TO SUIT
Dim FileName As String
 Let FileName = Dir(Path & "\*", vbNormal)
    Do While FileName <> ""
    Dim FullPathAndFileName As String
     Let FullPathAndFileName = Path & "\" & FileName
    MsgBox prompt:="The picture, it was selected, the full path and file name it is " & FullPathAndFileName
    
    '
    ' You can do other things here for each file
    '
    
     Let FileName = Dir
    Loop
End Sub

Alan

[muhammad susanto]

hi Alan, thank you but i can't see photos..
i have run with your all code
i have suite path file location but still not working
after running that code, showing

[DocAElstein]

Hi

...
after running that code, showing

Yes, that is what should happen, - That is what my macro does.

---

Did you understand this?

I can’t help you with a full solution because I have no experience inserting pictures. (Maybe someone else may help more later)
…..But I can show you again how we can loop to repeat something for more than one file in a folder
...

---

My macro shows you how to select all files in a folder.
I did not give you a full solution.

---

My macro will give you all your file path and file name. It loops for every file. That is what you need. Now you put the other coding here:

Sub DoItLoopy()
Dim Path As String
 Let Path = "C:\Users\Elston\Desktop\Picture Example Folder" '  CHANGE TO SUIT
Dim FileName As String
 Let FileName = Dir(Path & "\*", vbNormal)
    Do While FileName <> ""
    Dim FullPathAndFileName As String
     Let FullPathAndFileName = Path & "\" & FileName
     '   MsgBox prompt:="The picture, it was selected, the full path and file name it is " & FullPathAndFileName
    
    '
    ' You can do other things here for each file
    ' Put other coding here. It can be done on every file 
    
     Let FileName = Dir
    Loop
End Sub

Alan

[muhammad susanto]

hi Alan, thank you but i am still confuse how to combine your code into my code
like in post #1, with my code i can't select all pictures from 1 folder to inserted..
second problem, after can select all pictures, the picture should be placement into multiple cell with sequence
the macro is not original from me...i found it and actually i'm newbie about macro.

[DocAElstein]

Hi

You should not think of it as …. combine Alan code into muhammad code … that wont work. That’s wrong.
Correct is: combine muhammad code into Alan code


__Do While
__Dim FullPathAndFileName As String
__ Let FullPathAndFileName = Path & "" & FileName


___ muhammad code here


__Loop


That is a looping code section. It is done 2 times if you have two files, 3 times if you have three file, 4 times if you have 4 files, 5 times if you have 5 files, 6 times ……….etc.

Each time it is done, my FullPathAndFileName = your vPicture

In my example it would have looped 2 times because I had two files in my folder, Picture Example Folder, ( https://i.postimg.cc/7b8WngcR/Pictur...My-Desktop.jpg )


I do not think it is possible to explain this any easier. That is very very simple and most very basic looping programming understanding.

---

But I cannot tell you exactly what coding to put here, because I do not know how to do coding that involves inserting pictures. I have no experience inserting pictures.
Somebody else will need to help you if you are unable yourself to proceed further.

---

( For somebody else to help you, it might be easier for them to help you if you explain in more full detail of your requirements and include some sample files )

Alan

---

---

P.S.

.. actually i'm newbie about macro.

You have been doing macro for at least 9 years already . I have been doing macros for 6 years only. So I am super newbie

[muhammad susanto]

hi expert..
maybe my attachment new file make more clear & easy , now my target photos in cell C16, E16, G16, I16