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

我希望我明确这一点：

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

我想在超链接旁边有一个图标，表示它是否会打开Word文档，文件夹等。在文档列表中，我可以在超链接旁边的列中放置一个指示符（1表示word doc，2对于文件夹等），以便根据情况，正确的图标被发送旁边的正确types的文件超链接。

我已经设法通过简单地插入形状（word文档的蓝色矩形，文件夹的绿色），但我想有一个更具描述性的符号（像一个特定的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”或“文件夹”，然后着色单元格会更简单:)

 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 

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

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