VBA - Excel - 如何检索匹配文件名的照片并将它们放在单元格中

VBA - Excel - How to retrieve photos on matching file name and place them in cell

提问by user1783504

I have an excel sheet where column A has a list of product codes. I also have a folder with pictures of each product and file name of the pictures are the product code. I would like to place the picture of each product in column B beside their respective codes. If possible, I would also like to reformat the pictures so they fit in the cell.

我有一个 Excel 表，其中 A 列有一个产品代码列表。我还有一个文件夹，里面有每个产品的图片，图片的文件名是产品代码。我想将每个产品的图片放在它们各自代码旁边的 B 列中。如果可能，我还想重新格式化图片，使其适合单元格。

I don't really know where to start and any help would be greatly appreciated! thanks

我真的不知道从哪里开始，任何帮助将不胜感激！谢谢

采纳答案by bonCodigo

Here is a code to start. Please test it out in your side.

这是一个开始的代码。请在您身边进行测试。

 Sub AddPictures()
 Dim myPic As Picture
 Dim wkSheet As Worksheet
 Dim myRng As Range
 Dim myCell As Range
 Dim rowCount As Long
 Dim rowCount2 As Long

     Set wkSheet = Sheets(2) ' -- Change to your sheet

    '-- The usual way of finding used row count for specific column
    rowCount2 = wkSheet.Cells(wkSheet.Rows.Count, "C").End(xlUp).Row

    If rowCount2 <> 0 Then
        Set myRng = wkSheet.Range("C2", wkSheet.Cells(wkSheet.Rows.Count, "C").End(xlUp))

        For Each myCell In myRng.Cells
               If Trim(myCell.Value) = "" Then
                    MsgBox "No file path"
               ElseIf Dir(CStr(myCell.Value)) = "" Then
                    MsgBox myCell.Value & " Doesn't exist!"
               Else
                    myCell.Offset(0, 1).Parent.Pictures.Insert (myCell.Value)
                    Set myPic = myCell.Parent.Pictures.Insert(myCell.Value)

                    With myCell.Offset(0, 1)  '1 columns to the right of C ( is D)
                        '-- resize image here to fit into the size of your cell
                        myPic.Top = .Top
                        myPic.Width = .Width
                        myPic.Height = .Height
                        myPic.Left = .Left
                        myPic.Placement = xlMoveAndSize
                    End With
               End If
        Next myCell

    Else
        MsgBox "There is no file paths in your column"
    End If
End Sub

Output:

输出：

---

---

PS: set range, file paths according to your values. If you need to search entire sheet for used REAL columns and rows, let me know. I can share a function for that. Right now you only need to find used rows in the specific file-paths column, so the above typical used row count line is good enough.

PS：根据您的值设置范围，文件路径。如果您需要在整个工作表中搜索使用过的 REAL 列和行，请告诉我。我可以为此共享一个功能。现在你只需要在特定的文件路径列中找到使用过的行，所以上面典型的使用行计数行就足够了。