单击显示图像的形状或button（预览/closures）

我是VBA新手，正在寻求工作项目的帮助。 我已经做了一些研究，开始了，但现在已经过了头。

我的目标是：创build一个点击形状或button（预览/closures），显示从计算机上的另一个位置的图像。

所显示的图像将取决于在同一行中input的每个名称的数据input（列A：患者姓名;同名的jpeg图像）。

另外我想要一个新的button/形状在相应的单元格中自动创build一个新的名字被添加

谢谢瑞克

Sub Macro1() Dim Path As String Set myDocument = Worksheets(1) Path = "F:\CAD_CAM division\Unsorted Models\" myDocument.Pictures.Insert (Path & ActiveCell.Value & ".jpg") With ActiveSheet.Shapes("Rounded Rectangle 1").TextFrame2.TextRange.Characters If .Text = "Close" Then .Text = "Preview" ActiveSheet.Pictures.Delete Else .Text = "Close" With ActiveSheet.Shapes("Rounded Rectangle 1") End With End If End With End Sub 

Answer 1

虽然你的原始代码实际上是工作，我做了一些小的调整，以确保所有（多个）图片包括/显示在工作表上，并将这些图片alignment下面。 看看代码中的评论，让我知道你的想法：

 Option Explicit Sub Macro1() Dim lngRow As Long Dim strPath As String Dim picItem As Picture Dim shtPatient As Worksheet 'If there are multiple pictures then they should be shown ' underneath each other. dblLeft and dblTop will be used ' to place the next picture underneath the last one. Dim dblTop As Double Dim dblLeft As Double Set shtPatient = ThisWorkbook.Worksheets(1) strPath = "F:\CAD_CAM division\Unsorted Models\" With shtPatient.Shapes("Rounded Rectangle 1").TextFrame2.TextRange.Characters If .Text = "Close" Then .Text = "Preview" ActiveSheet.Pictures.Delete Else .Text = "Close" For lngRow = 2 To shtPatient.Cells(shtPatient.Rows.Count, "A").End(xlUp).Row 'First check if the file actually exists / can be found and inserted If Dir(strPath & shtPatient.Cells(lngRow, 1).Value2 & ".jpg") <> "" Then Set picItem = shtPatient.Pictures.Insert(strPath & shtPatient.Cells(lngRow, 1).Value2 & ".jpg") 'Name the picture so it can be found afterwards again using VBA picItem.Name = shtPatient.Cells(lngRow, 1).Value2 & ".jpg" If lngRow = 2 Then picItem.Top = shtPatient.Range("F2").Top picItem.Left = shtPatient.Range("F2").Left dblTop = picItem.Top + picItem.Height + 10 dblLeft = picItem.Left Else picItem.Top = dblTop picItem.Left = dblLeft dblTop = picItem.Top + picItem.Height + 10 End If End If Next lngRow End If End With End Sub