Question

我希望调整此代码，以便导入的图像与单元格的顶部/ CENTER 与顶部/ LEFT 对齐。任何帮助将不胜感激！

Sub Test()
Dim MySht As Worksheet
Dim MyPic As Shape
Dim MyLeft AsSingle, MyTop AsSingle


 MyTop = [C14].Top
 MyLeft = [C14].Left


Set MySht = ActiveSheet
Set MyPic = MySht.Shapes.AddPicture("C:\Users\Sryan\Desktop\Untitled.png", _
msoFalse, msoTrue, MyLeft, MyTop,-1,-1)
' ^^^ LinkTo SaveWith -1 = keep size

' now resize pic
MyPic.Height =100

EndSub

Answer 1

只需使用[C14].Left + 0.5 * [C14].Width。

如果图像的宽度为W，并且您希望将图像的中间位置与单元格的中间位置匹配，那么单元格中间的位置仍为[C14].Left + 0.5 * [C14].Width，并且您必须减去宽度的一半，所以图像Left必须是

[C14].Left + 0.5 * ([C14].Width - W)

Answer 2

代码如下。

Sub Test()
Dim MySht As Worksheet
Dim MyPic As Shape
Dim MyLeft As Single, MyTop As Single
Dim myFn As String, w As Single, h As Single

myFn = "C:\Users\Sryan\Desktop\Untitled.png"
Set MySht = ActiveSheet
With MySht.Range("c14")
    MyTop = .Top + 1
    MyLeft = .Left + 1
    w = .Width - 2
    h = .Height + 2
End With

Set MyPic = MySht.Shapes.AddPicture(myFn, msoFalse, msoTrue, MyLeft, MyTop, w, h)

End Sub

Bellow code是一种保持宽高比的方法。

Sub Test()
Dim MySht As Worksheet
Dim MyPic As Shape
Dim MyLeft As Single, MyTop As Single
Dim myFn As String, w As Single, h As Single

myFn = "C:\Users\Sryan\Desktop\Untitled.png"
Set MySht = ActiveSheet

GetPicture myFn, MySht.Range("c14")

End Sub
Sub GetPicture(strPic As String, rngPic As Range)
    Dim Pic As Picture
    Dim shp As Shape
    Dim l As Single, t As Single, w As Single, h As Single
    Dim Rt As Single, myL As Single, myT As Single

    Set Pic = ActiveSheet.Pictures.Insert(strPic)

    With Pic
        h = .Height
        w = .Width
    End With
    Pic.Delete

    With rngPic
        If h = w Then
            t = .Top
            l = .Left
            w = .Width
            h = .Height
        ElseIf h > w Then
            Rt = w / h
            t = .Top
            h = .Height
            w = .Height * Rt
            myL = (.Width - w) / 2
            l = .Left + myL
        ElseIf h < w Then
            Rt = h / w
            w = .Width
            h = .Width * Rt
            If h > .Height Then
                h = .Height
                w = h / Rt
            End If
            myL = (.Width - w) / 2
            myT = (.Height - h) / 2
            l = .Left + myL
            t = .Top + myT
        End If


        Set shp = ActiveSheet.Shapes.AddPicture(strPic, msoCTrue, msoCTrue, l, t, w, h)

     End With
End Sub

居中嵌入式图像

2 个答案: