Insert multiple images at once from a folder to Ro

问题:

Good morning everyone!

So I have taken this code from extendoffice.com/documents/excel/1156-excel-insert-multiple-pictures.html as it should be seen below.

What I want to know is if anyone can help me with -

Having all the photos import across 'Row B', instead of in a column fashion. And how to add the 'File Names' (i.e. excel_image2.jpg) of said images, above each of their image in 'Row A'.

Thanks for all the help ahead of time!

Sub InsertPictures()
'Update 20140513
Dim PicList() As Variant
Dim PicFormat As String
Dim Rng As Range
Dim sShape As Shape
On Error Resume Next
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
xColIndex = Application.ActiveCell.Column
If IsArray(PicList) Then
    xRowIndex = Application.ActiveCell.Row
    For lLoop = LBound(PicList) To UBound(PicList)
        Set Rng = Cells(xRowIndex, xColIndex)
        Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
    xRowIndex = xRowIndex + 1
    Next
End If
End Sub

回答1:

Assuming "Row B" is "Row 2" and "Row A" is "Row 1" you could try this:

Option Explicit

Sub InsertPictures()
    'Update 20140513
    Dim PicList() As Variant
    Dim lLoop As Long

    PicList = Application.GetOpenFilename(MultiSelect:=True)
    If IsArray(PicList) Then
        For lLoop = LBound(PicList) To UBound(PicList)
            With Cells(2, 1).Offset(, lLoop - 1)
                ActiveSheet.Shapes.AddPicture PicList(lLoop), msoFalse, msoCTrue, .Left, .top, .Width, .Height
                .Offset(-1).Value = Right(PicList(lLoop), Len(PicList(lLoop)) - InStrRev(PicList(lLoop), "\"))
            End With
        Next
    End If
End Sub

回答2:

If you want only file name, try this:

Sub InsertPictures()
    'Update 20140513
    Dim PicList() As Variant
    Dim PicFormat As String
    Dim Rng As Range
    Dim sShape As Shape
    Dim Filename As String
    On Error Resume Next
    PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
    xColIndex = Application.ActiveCell.Column
    If IsArray(PicList) Then
        xRowIndex = Application.ActiveCell.Row
        For lLoop = LBound(PicList) To UBound(PicList)
            Filename = Dir(PicList(lLoop), vbDirectory)  `~~> Getting only filename from path
            Cells(xRowIndex, xColIndex) = Filename
            Set Rng = Cells(xRowIndex, xColIndex + 1)
            Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
        xRowIndex = xRowIndex + 1
        Next
    End If
End Sub

回答3:

ManishChristian- This does just the file name but it's in Column A and Column B.

user3598756- has it going to 'Row 1' for the 'File Address' and 'Row 2'for the images which is exactly what I wanted.

I just need either Manish's to go from Column A and B to Rows 1 and 2 or for user3598756 to chop down to just the file name with extension, not the full path.

I tried just adding "Filename = Dir(PicList(lLoop), vbDirectory) `~~> Getting only filename from path" (without your comment) to Manish's lLoop but it error'd.

Thanks