Excel宏代码插入图片

Sub AAA()
    On Error Resume Next
    Dim t As String, fd
    Dim MR As Range
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)    '允许用户选择一个文件夹
    If fd.Show = -1 Then
        t = fd.SelectedItems(1)    '选择之后就记录这个文件夹名称
    Else
        Exit Sub    '否则就退出程序
    End If
    p = InputBox("请选择图片插入位置，上，下，左，右依次用1，2，3，4代替", "请选择位置")
    Set fso = CreateObject("scripting.filesystemobject")
    For Each MR In Selection
    If Not IsEmpty(MR) Then
        pic = t & "\" & MR.Value & ".jpg"
        If fso.fileexists(pic) Then
            MR.Select
            If (p = 1) Then '上
                ML = MR.Left
                MT = MR.Top - MR.Height
                MW = MR.Width
                MH = MR.Height
            ElseIf (p = 2) Then '下
                ML = MR.Left
                MT = MR.Top + MR.Height
                MW = MR.Width
                MH = MR.Height
            ElseIf (p = 3) Then '左
                ML = MR.Left - MR.Width
                MT = MR.Top
                MW = MR.Width
                MH = MR.Height
            ElseIf (p = 4) Then '右
                ML = MR.Left + MR.Width
                MT = MR.Top
                MW = MR.Width
                MH = MR.Height
            End If
            ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select
            Selection.ShapeRange.Fill.UserPicture pic     '当前文件所在目录下以当前单元内容为名称的.jpg图片
        End If
    End If
    Next
End Sub