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

Question

我希望我说清楚：

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

我想在超链接旁边有一个图标，指示它是否会打开一个word文档、一个文件夹等。在文档列表中，我可以在超链接旁边的列中放置一个指示符（1代表word 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

在我的 cmets 之外，这是插入图片并将它们放置在 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

我使用了以下图片。你可以下载这些或使用任何你喜欢的东西。

当你运行上面的代码时，你会得到这样的输出