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

Question

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

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

Answer 1

这是开始的代码。请在你身边测试一下。

 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

输出：

---

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