EXCEL VBA 根据单元格值自动添加图片

我们计划实现的功能就是在单元格（第12行）中输入姓名就可以在上方单元格内显示他的头像，具体如下图所示：

0415A.png

而全部的图片保存在EXCEL文件同级的【图片库】文件夹中

0415B.png

Private Sub Worksheet_Change(ByVal Target As Range)
    
    '错误时跳过
    On Error Resume Next
    
    '自动添加关键岗位的微信头像图片
    If Target.Row = 12 And Target.Column >= 3 And Target.Column <= 12 Then
    
        '图片文件夹所在路径
        Path = ThisWorkbook.Path & "\图片库\"
        Name = ActiveCell.Offset(-1, 0).Value

        '如果单元格为空则退出
        If IsEmpty(ActiveCell.Offset(-1, 0)) Then Exit Sub
        
        '定义图片的位置和宽高
        mLeft = ActiveCell.Offset(-2, 0).MergeArea.Left + 1
        mTop = ActiveCell.Offset(-2, 0).MergeArea.Top + 1
        mWidth = ActiveCell.Offset(-2, 0).MergeArea.Width - 2
        mHeight = ActiveCell.Offset(-2, 0).MergeArea.Height - 2
        
        '拼接可能的图片名称
        Pic1 = Path + Name + ".png"
        Pic2 = Path + Name + ".jpg"
        Pic3 = Path + Name + ".gif"
        Pic4 = Path + Name + ".bmp"
        
        '删除原来加入的图片
        '获取指定图片的名称 Left(shp.Name, LenB(StrConv(shp.Name, vbFromUnicode)) - 4)
        For Each shp In ActiveSheet.Shapes
            If shp.Top >= mTop And shp.Left >= mLeft And shp.Top <= mTop + mHeight And shp.Left <= mLeft + mWidth Then
                shp.Delete
            End If
        Next
        
        '添加微信头像图片
        If IsFileExists(Pic1) Then
            Me.Shapes.AddPicture Pic1, True, True, mLeft, mTop, mWidth, mHeight
        ElseIf IsFileExists(Pic2) Then
            Me.Shapes.AddPicture Pic2, True, True, mLeft, mTop, mWidth, mHeight
        ElseIf IsFileExists(Pic3) Then
            Me.Shapes.AddPicture Pic3, True, True, mLeft, mTop, mWidth, mHeight
        ElseIf IsFileExists(Pic4) Then
            Me.Shapes.AddPicture Pic4, True, True, mLeft, mTop, mWidth, mHeight
        Else
            MsgBox "图片库中不存在该微信头像，请添加！<br/>图片格式可以：PNG/JPG/GIF/BMP", vbOKOnly + vbExclamation, "注意"
        End If
        
    End If
    
End Sub

封装一个查询文件是否存在的函数

'判断文件是否存在（VBA）
Function IsFileExists(ByVal strFileName As String) As Boolean
    If Dir(strFileName, 16) <> Empty Then
        IsFileExists = True
    Else
        IsFileExists = False
    End If
End Function