Question

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

我的目标是：创建一个单击形状或按钮（预览/关闭），显示计算机上其他位置的图像。

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

此外，我希望在添加新名称时在相应的单元格中自动创建新的按钮/形状

谢谢里克

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

当您的原始代码实际正常工作时，我进行了一些微调，以确保所有（多张）图片都包含/显示在工作表上，并将这些图片彼此对齐。看看代码中的注释，让我知道你的想法：

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

单击显示图像的形状或按钮（预览/关闭）

1 个答案: