在单元格中或上方插入图片/图标

Question

我希望我说清楚：

我有一个循环复制特定单元格中的某些超链接（它们来自文档列表，文件路径，文档名称等存储在另一个工作表中）。

我想在超链接旁边有一个图标，指示它是否会打开word文档，文件夹等。在文档列表中，我可以在超链接旁边的列中放置一个指示符（1个用于单词） doc，2表示文件夹等）这样根据具体情况，右侧图标会被发送到正确类型的文档超链接旁边。

我设法通过简单地插入形状（蓝色矩形用于word doc，绿色用于文件夹）来实现它，但我想要一个更具描述性的符号（可能是特定的FaceID？）。这是我的代码（为简单而愚蠢）：

Sub Icons()
Dim i As Integer
Dim sh As Object
'Only loops through A1:A5 for simplicity
'Looks at the associated indicator located in the previous sheet
'Assigns a shape depending if it is 1 or 2
For i = 1 To 5
    If Feuil1.Range("A" & i) = "1" Then
        Set sh = Feuil2.Shapes.AddShape(msoShapeRectangle, Range("A"& i).Left, Range("A" & i).Top, 15, 15)
    sh.Name = "WordDocIcon" & i
    sh.Fill.ForeColor.RGB = RGB(0, 220, 220)
End If

If Feuil1Range("A" & i) = "2" Then
        'It is easy to do when inserting a given msoShape, but I want something else!
    Set sh = Feuil2.Shapes.AddShape(msoShapeRectangle, Range("A" & i).Left, Range("A" & i).Top, 15, 15)
    sh.Name = "FolderIcon" & i
    sh.Fill.ForeColor.RGB = RGB(100, 100, 0)
End If
Next
End Sub

Answer 1

继续我的评论，以下是如何插入图片并将它们放在列B中。我仍然会说在B列中键入“Word”或“Folder”然后着色单元格会更简单:)

Sub Sample()
    Dim ws As Worksheet
    Dim picWord As String
    Dim picFolder As String
    Dim Shp As Shape
    Dim i As Long

    picWord = "C:\Users\Siddharth\Desktop\Word.Jpg"
    picFolder = "C:\Users\Siddharth\Desktop\folder.Jpg"

    Set ws = ThisWorkbook.Sheets("Feuil1")

    With ws
        For i = 1 To 5
            If .Range("A" & i) = "1" Then
                With .Pictures.Insert(picWord)
                    With .ShapeRange
                        .LockAspectRatio = msoTrue
                        .Width = ws.Range("B" & i).Width
                        .Height = ws.Range("B" & i).Height
                    End With
                    .Left = ws.Range("B" & i).Left
                    .Top = ws.Range("B" & i).Top
                    .Placement = 1
                    .PrintObject = True
                End With
            ElseIf .Range("A" & i) = "2" Then
                With .Pictures.Insert(picFolder)
                    With .ShapeRange
                        .LockAspectRatio = msoTrue
                        .Width = ws.Range("B" & i).Width
                        .Height = ws.Range("B" & i).Height
                    End With
                    .Left = ws.Range("B" & i).Left
                    .Top = ws.Range("B" & i).Top
                    .Placement = 1
                    .PrintObject = True
                End With
            End If
        Next i
    End With
End Sub

我使用了以下图片。您可以下载这些或使用您喜欢的任何内容。

运行上面的代码时，您将获得此类输出