VBA 根据字符串名称从文件夹中获取图片。包含通配符

Question

我有一个包含 160 行和 2 列数据的 excel 文件 - 文章名称、价格。 我还有一个文件夹，其中包含这些文章的照片。

问题是图片名称与我的 excel 表中的文章名称不完全相同。

例如，在我的工作表中，我的文章名称为：“3714-012-P140”，但在文件夹中为“3714-012-P140--- ****”。

但是，在最初的 3 块代码（示例中为 3714；012；P140）之后，搜索中将始终只显示 1 张图片。

如何选择带有通配符的图片？

另外，我将如何将图片锁定到 excel 中的特定单元格中？我的意思是，当我调整或删除某些行/列时，图片会沿着分配给它们的单元格移动。

Dim ws As Worksheet
Dim articleCode As String, _
    findStr     As String
Set ws = Workbooks(1).Worksheets(1)

For i = 1 to ws.UsedRange.Rows.Count
    articleCode = ws.Cells(i,1)
    findStr = 'some code
    ActiveSheet.Pictures.Insert( _
        "C:\...path...\" & findStr & ".jpg").Select
Next i

编辑：我需要将照片插入每行数据的第三列。

Answer 1

关于将图片“锁定”到特定单元格中。

有关如何将形状链接到单元格的信息，请参阅 here。

基本上你需要：

1. 将图片放在单元格上。这可以通过将图片（即形状）.Top 和 .Left 属性设置为与图片链接到的单元格相同来完成。

2. 将形状的公式设置为等于单元格引用（这也会将形状调整为与单元格相同的大小，并在单元格大小更改时使其调整大小）。见here

以下取自here 的代码将帮助您在文件夹中找到与“查找字符串”匹配的文件。 （需要调整！）

Sub FindPatternMatchedFiles()

    Dim objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Dim objRegExp As Object
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.pattern = ".*xlsx"
    objRegExp.IgnoreCase = True

    Dim colFiles As Collection
    Set colFiles = New Collection

    RecursiveFileSearch "C:\Path\To\Your\Directory", objRegExp, colFiles, objFSO

    For Each f In colFiles
        Debug.Print (f)
        'Insert code here to do something with the matched files
    Next

    'Garbage Collection
    Set objFSO = Nothing
    Set objRegExp = Nothing

End Sub

Answer 2

让您现有的代码调用一个接受文章名称 (articleCode) 并返回图像文件路径的函数：

strImage = FindImage(articleCode)
If Len(strImage) > 0 Then ActiveSheet.Pictures.Insert strImage

然后你可以这样写你的函数：

Function FindImage(strArticle As String) As String

    Dim objFile As Object
    With CreateObject("Scripting.FileSystemObject")
        For Each objFile In .GetFolder("c:\path\to\images").Files
            If StrComp(Left$(objFile.Name, Len(strArticle)), strArticle, vbTextCompare) = 0 Then

                ' Found an image file that begins with the article code.
                FindImage = objFile.Path
                Exit Function

            End If
        Next
    End With

End Function

Answer 3

下面的函数接受articleCode，它是图片的名称，应该输入图片的行和列。

Function picInsert(articleCode As String, row As Integer, column As Integer)
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim ws As Worksheet
Set ws = Workbooks(1).Worksheets(2) 'your worksheet where the pictures will be put

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("...path...")

i = 1
For Each objFile In objFolder.Files
    If objFile.name Like (articleCode & "*") Then 'finds a picture with similar name to the one searched
        With ActiveSheet.Pictures.Insert(objFile.Path)
            With .ShapeRange
                .LockAspectRatio = msoTrue
                .Width = 5
                .Height = 15
            End With
            .Left = ActiveSheet.Cells(row, column).Left
            .Top = ActiveSheet.Cells(row, column).Top
            .Placement = 1 'locks the picture to a cell
        End With
    End If
    i = i + 1
Next objFile
End Function

这是一个测试子，我用它尝试了上面的功能。基本上是一个简单的循环，它遍历行，从第一列获取 articleCode 并使用上面的函数将图片输入到第三列。

Public Sub test()
Dim ws As Worksheet
Dim i As Integer
Dim articleCode As String
Set ws = Workbooks(1).Worksheets(2)

For i = 1 To ws.UsedRange.Rows.Count
    articleCode = ws.Cells(i, 1)
    Call picInsert(articleCode, i, 3)
Next i
End Sub