尝试运行宏以提示选择图像，然后将其放置到工作簿中，它将图片的大小调整为目标列的宽度（我想要的），但不会调整行高以匹配图像的高度

我尝试过切换功能等，但是row.height似乎没有任何作用

    Sub uploadpic()
    Dim r As Range,Shrink As Long
    Dim shpPic As Shape
    Dim shpPic2 As Shape
    Dim myfile As String
    Dim myfile2 As String
    Application.ScreenUpdating = True
    Shrink = 0

            'got some code running here in between that isn't causing an issue



    On Error Resume Next


    For Each r In Range("K2:K" & Cells(Rows.Count,1).End(xlUp).Row)


If r.Value = "" Then
myfile = Application.GetOpenFilename(FileFilter:="Pictures,*.jpg; *.gif; *.png",Title:="Select an Issue Picture",MultiSelect:=False)
    ThisWorkbook.Sheets("DATA").Range("K2").Value = myfile
    Set shpPic = activeSheet.Shapes.AddPicture(Filename:=myfile,linktofile:=msoFalse,_
        savewithdocument:=msoTrue,Left:=Cells(r.Row,12).Left + Shrink,Top:=Cells(r.Row,12).Top + Shrink,_
            Width:=-1,Height:=-1)
    With shpPic
        .LockAspectRatio = msoTrue
        .Width = Columns(12).Width - (2 * Shrink)
        Rows("2:2").RowHeight = .Height + (2 * Shrink)

              End With
        'corrective action pic
        myfile2 = Application.GetOpenFilename(FileFilter:="Pictures,Title:="Select an Corrective Picture",MultiSelect:=False)
            ThisWorkbook.Sheets("DATA").Range("M2").Value = myfile2
            Set shpPic2 = activeSheet.Shapes.AddPicture(Filename:=myfile2,14).Left + Shrink,14).Top + Shrink,Height:=-1)
    With shpPic2
        .LockAspectRatio = msoTrue
        .Width = Columns(14).Width - (2 * Shrink)
         Rows("2:2").RowHeight = .Height + (2 * Shrink)


End With
End If
    Next r

    Application.ScreenUpdating = True


    End Sub

我希望出现提示，以添加2张照片“问题图片”和“校正图片”，然后将其放置在第12和14列中，其中照片会调整大小以适合列宽，但行高度会进行调整以匹配图片高度。