在VBA中从图片裁剪固定区域

我想创建一个PowerPoint VBA脚本，该脚本插入图片，以便将图片裁剪为相对于图像顶部和左侧的固定大小。作为起点，我想使用以下VBA脚本：

Sub Insert_Traverse_1()
    Dim oPic As Shape
    Set oPic = ActiveWindow.View.Slide.Shapes.AddPicture("\\nlamvfs00065\homes\nlkpec\newpic.png", False, True, 0, 0, -1, -1)
        oPic.PictureFormat.CropLeft = 110
        oPic.PictureFormat.CropTop = 85
        oPic.PictureFormat.CropRight = 16
        oPic.PictureFormat.CropBottom = 55
        oPic.Height = 7.5 * 72
        oPic.Left = 0 * 72
        oPic.Top = 0 * 72
        oPic.ZOrder msoSendToBack
End Sub

此VBA脚本插入图片“newpic.png”，它表示窗口的屏幕抓取，并从边缘裁剪固定数量（表示窗口的边框）。如果我想要的确实是整个窗口，那么这很好用

不过，现在我想制作另一个VBA脚本，它插入窗口的某个部分，相对于窗口的左上角具有固定的大小和位置。然而，问题是“CropRight”和“CropBottom”现在取决于窗口的大小。我尝试了以下方法：

Sub Insert_Well_Tie_TZ()
    Dim oPic As Shape
    Set oPic = ActiveWindow.View.Slide.Shapes.AddPicture("\\nlamvfs00065\homes\nlkpec\newpic.png", False, True, 0, 0, -1, -1)
        ppi = 72                    'points per inch (=72 always)
        dpi = 96                    'dots per inch (=96 for my screen)
        oWidth = oPic.Width         'width of the shape in pixels
        oHeight = oPic.Height       'height of the shape in pixels
        oWidthPoints = oWidth * ppi / dpi   'width of the shape in points
        oHeightPoints = oHeight * ppi / dpi 'height of the shape in points
        L = 182                     'number of points to crop from the left
        T = 394                     'number of points to crop from the top

        oPic.PictureFormat.CropLeft = L
        oPic.PictureFormat.CropRight = oWidthPoints - L + 665
        oPic.PictureFormat.CropTop = T
        oPic.PictureFormat.CropBottom = oHeightPoints - T + 318
        ' oPic.Height = 7.5 * 72
        oPic.Left = 0 * 72
        oPic.Top = 0 * 72
        oPic.ZOrder msoSendToBack
End Sub

据我所知，“CropLeft”等以点（=1/72英寸）为单位表示，而“.Width”和“.Height”属性以像素为单位表示；这就是为什么我加入了一个72/96的转换因子来将图片的宽度从像素转换为点

---

这样做的目的是，通过考虑从右侧裁剪的图像宽度，无论窗口大小如何，被裁剪的图像部分都应该看起来相同。然而，我发现情况并非如此，我可能有一些比例因子错误。有人能看到问题吗？

如果要从左侧裁剪182点，只保留下一个665点，从右侧裁剪其他所有点，则只需更改一个标志，替换：

oPic.PictureFormat.CropRight = oWidthPoints - L + 665

与

代数是：

oWidthPoints=左裁剪+中裁剪+右裁剪

，所以

rightCrop = oWidthPoints - leftCrop - middle

以类似方式，替换：

oPic.PictureFormat.CropBottom = oHeightPoints - T + 318

与

---

我设法解决了一个特殊情况下的问题，即固定宽度的图片的一部分。代码如下：

Sub Insert_Well_Tie_Fit_To_Slide()
    Dim sh As Double
    Dim sw As Double
    Dim sa As Double
    With ActivePresentation.PageSetup
        sh = .SlideHeight       ' Slide height (usually 10 inches * 72 points/inch = 720 points)
        sw = .SlideWidth        ' Slide width (usually 7.5 inches * 72 points/inch = 540 points)
    End With
    sa = sh / sw                ' Slide aspect ratio (usually 3/4)

    Dim cl As Double
    Dim ct As Double
    Dim cr As Double
    Dim cb As Double
    cl = 0.05 * 72      ' Points to crop from the left
    ct = 0.72 * 72       ' Points to crop from the top
    cb = 0.72 * 72      ' Points to crop from the bottom
    fw = 10.17 * 72     ' Final width

    Dim oPic As Shape
    Set oPic = ActiveWindow.View.Slide.Shapes.AddPicture("\\nlamvfs00065\homes\nlkpec\newpic.png", False, True, 0, 0, -1, -1)
        With oPic
            .ScaleHeight 1, msoTrue, msoScaleFromTopLeft
            .PictureFormat.CropLeft = cl
            .PictureFormat.CropTop = ct
            .PictureFormat.CropBottom = cb
            w1 = .Width
            cr = w1 - fw - cl       ' Points to crop from the right
            .PictureFormat.CropRight = cr
            h = .Height
            w = .Width
            a = h / w           ' Aspect ratio of picture
            If a > sa Then      ' For 'narrow' pictures, set height equal to height of the slide
                .Height = sh
                .Left = 0
                .Top = 0
            ElseIf a <= sa Then ' For 'wide' pictures, set width equal to width of the slide
                .Width = sw
                .Left = 0
                nh = .Height    ' New height of the picture after cropping and resizing
                .Top = sh - nh  ' Align to bottom of the slide
            End If
            .ZOrder msoSendToBack
        End With
End Sub

Sub-Insert_-Well_-Tie_-Fit_-To_-Slide（）
双份的
双色调暗开关
双倍的
使用ActivePresentation.PageSetup
sh=.SlideHeight的滑动高度（通常为10英寸*72点/英寸=720点）
sw=.SlideWidth滑动宽度（通常为7.5英寸*72点/英寸=540点）
以
sa=sh/sw‘滑动纵横比（通常为3/4）
双精度cl
双精度ct
双色调暗
将cb设置为双精度
cl=0.05*72'点从左侧裁剪
ct=0.72*72'点从顶部裁剪
cb=0.72*72'点从底部裁剪
fw=10.17*72'最终宽度
像形状一样暗淡
设置oPic=ActiveWindow.View.Slide.Shapes.AddPicture（\\nlamvfs00065\homes\nlkpec\newpic.png），假、真、0、0、-1、-1）
与oPic
.缩放高度1，msoTrue，MSOSCALE从左上角
.PictureFormat.CropLeft=cl
.PictureFormat.CropTop=ct
.PictureFormat.CropBottom=cb
w1=.Width
cr=w1-fw-cl'指向从右侧裁剪的点
.PictureFormat.CropRight=cr
h=.高度
w=宽度
a=图片的高宽比
如果a>sa，则对于“窄”图片，将高度设置为幻灯片的高度
.高度=sh
.左=0
.Top=0
ElseIf a>>“而“.Width”和“.Height”属性以像素表示”否。所有形状尺寸均以点表示。感谢您的评论；事实上，“+665”和“+318”这两个术语是根据第一次裁剪出所需区域的轨迹和误差确定的。我意识到这些应该是负数；事实上，它们不是反映了我不明白长度单位到底代表什么。
oPic.PictureFormat.CropBottom = oHeightPoints - T - 318

Sub Insert_Well_Tie_Fit_To_Slide()
    Dim sh As Double
    Dim sw As Double
    Dim sa As Double
    With ActivePresentation.PageSetup
        sh = .SlideHeight       ' Slide height (usually 10 inches * 72 points/inch = 720 points)
        sw = .SlideWidth        ' Slide width (usually 7.5 inches * 72 points/inch = 540 points)
    End With
    sa = sh / sw                ' Slide aspect ratio (usually 3/4)

    Dim cl As Double
    Dim ct As Double
    Dim cr As Double
    Dim cb As Double
    cl = 0.05 * 72      ' Points to crop from the left
    ct = 0.72 * 72       ' Points to crop from the top
    cb = 0.72 * 72      ' Points to crop from the bottom
    fw = 10.17 * 72     ' Final width

    Dim oPic As Shape
    Set oPic = ActiveWindow.View.Slide.Shapes.AddPicture("\\nlamvfs00065\homes\nlkpec\newpic.png", False, True, 0, 0, -1, -1)
        With oPic
            .ScaleHeight 1, msoTrue, msoScaleFromTopLeft
            .PictureFormat.CropLeft = cl
            .PictureFormat.CropTop = ct
            .PictureFormat.CropBottom = cb
            w1 = .Width
            cr = w1 - fw - cl       ' Points to crop from the right
            .PictureFormat.CropRight = cr
            h = .Height
            w = .Width
            a = h / w           ' Aspect ratio of picture
            If a > sa Then      ' For 'narrow' pictures, set height equal to height of the slide
                .Height = sh
                .Left = 0
                .Top = 0
            ElseIf a <= sa Then ' For 'wide' pictures, set width equal to width of the slide
                .Width = sw
                .Left = 0
                nh = .Height    ' New height of the picture after cropping and resizing
                .Top = sh - nh  ' Align to bottom of the slide
            End If
            .ZOrder msoSendToBack
        End With
End Sub