一次将多个图像从文件夹插入到行 + 文件名答案

【问题标题】：Insert multiple images at once from a folder to Rows + Filename一次将多个图像从文件夹插入到行 + 文件名
【发布时间】：2017-06-17 06:19:50
【问题描述】：

大家早上好！

所以我从extendoffice.com/documents/excel/1156-excel-insert-multiple-pictures.html 获取了这段代码，如下所示。

我想知道是否有人可以帮助我-

将所有照片导入“B 行”，而不是按列方式导入。以及如何在“A 行”中的每个图像上方添加所述图像的“文件名”（即 excel_image2.jpg）。

感谢您提前提供的所有帮助！

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

【问题讨论】：

什么是“B 行”？行有数字索引，列有字母索引

标签： image vba excel import

【解决方案1】：

假设“B 行”是“第 2 行”，“A 行”是“第 1 行”，您可以试试这个：

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

【讨论】：

这正是我正在寻找的，除了我不需要整个“文件位置”，现在它正在做，即“C:\My Documents\etc 等”我只需要它要做实际的“image1.jpg”吗？但是你一针见血，抱歉，这周的开始很慢，是的，第 1 行和第 2 行。提前感谢您的帮助！
谢谢，刚刚看到你编辑了它！你们都很棒，我很感激！

【解决方案2】：

如果你只想要文件名，试试这个：

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- 这只是文件名，但它位于 A 列和 B 列中。

user3598756- 将“文件地址”转到“第 1 行”，将图像转到“第 2 行”，这正是我想要的。

我只需要 Manish's 从 A 列和 B 列转到第 1 行和第 2 行，或者让 user3598756 缩减为仅带有扩展名的文件名，而不是完整路径。

我尝试在 Manish 的 lLoop 中添加“Filename = Dir(PicList(lLoop), vbDirectory) `~~> Getting only filename from path”（没有您的评论）但它出错了。

谢谢

【讨论】：

这不是答案！删除它并编辑您的问题