Question

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

我可以插入图片但不取决于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中的值进行更新。

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

2 个答案: