Excel-使用vba中的单元格值自动更改图片

Question

我想根据AB32值在单元格AH32自动插入图片。

我可以插入图片，但不取决于AB32的值。 我该如何解决这个问题？

代码：

Sub Picture()

   Range("AH32").Select

   Dim picname As String

   If Range("AB32").Value < 85# Then

        picname = "C:\Users\20149308\Desktop\sucess\images" & ".png" 'Link to the Picture
        ActiveSheet.Pictures.Insert(picname).Select

        With Selection

            .Left = Range("AH32").Left
            .Top = Range("AH32").Top
            .ShapeRange.LockAspectRatio = msoFalse
            .ShapeRange.Height = 80#
            .ShapeRange.Width = 80#
            .ShapeRange.Rotation = 0#

        End With

    ElseIf Range("AB32").Value >= 85# Then

        picname = "C:\Users\20149308\Desktop\sucess\succ" & ".jpg"  'Link to the Picture
        ActiveSheet.Pictures.Insert(picname).Select

        With Selection

            .Left = Range("AH32").Left
            .Top = Range("AH32").Top
            .ShapeRange.LockAspectRatio = msoFalse
            .ShapeRange.Height = 80#
            .ShapeRange.Width = 80#
            .ShapeRange.Rotation = 0#

        End With

    End If

    Range("AH32").Select

    Application.ScreenUpdating = True

    Exit Sub

ErrNoPhoto:
    MsgBox "Unable to Find Photo" 'Shows message box if picture not found
    Exit Sub

End Sub

Answer 1

这是一种以更简洁的形式编写它并进行一些基本错误检查的方法。

Option Explicit

Sub Picture()

   Application.ScreenUpdating = True

   Dim testRange As Range
   Dim picname As String

   Set testRange = ActiveSheet.Range("AB32") 

   If IsEmpty(testRange) Then
       MsgBox "No value in cell AB32"
       Exit Sub
   End If

   Select Case True

        Case Not IsNumeric(testRange.Value2)

            MsgBox "Value in cell AB32 is not numeric"
            Exit Sub

        Case testRange.Value2 < 85#

            picname = "C:\Users\20149308\Desktop\sucess\images" & ".png"

        Case testRange.Value2 >= 85#

            picname = "C:\Users\20149308\Desktop\sucess\succ" & ".jpg"

    End Select

    On Error GoTo ErrNoPhoto

    ActiveSheet.Pictures.Insert(picname).Select

    With Selection

        .Left = Range("AH32").Left
        .Top = Range("AH32").Top
        .ShapeRange.LockAspectRatio = msoFalse
        .ShapeRange.Height = 80#
        .ShapeRange.Width = 80#
        .ShapeRange.Rotation = 0#

    End With

    Application.ScreenUpdating = True

    Exit Sub

ErrNoPhoto:
    MsgBox "Unable to Find Photo" 'Shows message box if picture not found
    Exit Sub

End Sub

Answer 2

您可以使用Camera在没有任何 VBA 的情况下执行此操作。 您可以通过依次选择文件、选项和自定义功能区并将相机图标添加到功能区来找到它。

• 创建一个空白工作表并调整列宽/行高，以便您的每张图片都位于单元格的边界内（在我的示例中，我使用的是 B2 和 B4）。
• 选择其中一个单元格，然后单击camera图标为其拍照。
• 切换到您的报告单并单击它以粘贴您刚刚拍摄的照片。 您将在可以旋转和调整大小的图片框中看到您最初单击的单元格的图片。
• 将您的两张图片粘贴到空白工作表上的单元格中。 报告表上的图片框现在将显示您单击的单元格中的图片。
• 使用此公式创建命名范围（调整工作表名称以适应）：
  =IF(Sheet1!$AB$32<85,Sheet2!$B$2,Sheet2!$B$4) - 绝对引用在这里很重要。
  我称范围为DisplayImage 。

• 选择图片框并将公式栏中的公式更改为=DisplayImage 。

• 图像现在将根据单元格AB32的值进行更新。