2

我有一个更新 PowerPoint 演示文稿中所有链接的例程。但是，如果组成链接的图像已调整大小，它们将以相同的大小出现，这会使它们变形。

我希望确定图像链接的原始比例，然后在更新后将其重置为该比例（并非我们所有的图像都缩放相同，所以我不能简单地将它们重新缩放为 100% 或你有什么）。

ScaleWidth 和 ScaleHeight 方法似乎没有任何可以读取的相关属性。

http://msdn.microsoft.com/en-us/library/microsoft.office.interop.powerpoint.shape.scalewidth%28v=office.14%29.aspx

Dim objPres As Object
Dim objSlide As Object
Dim objShape As Object
Dim myPath As String
Dim myName As String
Dim valueWidth As Long
Dim valueHeight As Long

Dim sl As Slide, sh As Shape, myMaster As Integer, count As Integer, relinked As Integer, lt As CustomLayout, sm As Master, ds As Design
Dim failureCounter As String, successCounter As Integer
successCounter = 0
'pages
For Each objSlide In ActivePresentation.Slides
For Each objShape In objSlide.Shapes
    If objShape.Type = msoLinkedPicture Then
        myName = objShape.LinkFormat.SourceFullName
        valueWidth = objShape.ScaleWidth '<- this does not work
        valueHeight = objShape.ScaleHeight '<- this does not work
        If Dir(myName) <> "" Then
            objShape.LinkFormat.update
            successCounter = successCounter + 1
            objShape.ScaleWidth valueWidth, msoTrue
            objShape.ScaleHeight valueHeight, msoTrue
        Else
            failureCounter = failureCounter & "," & myName
        End If
    End If
Next objShape
Next objSlide
4

1 回答 1

2

我想出了一个解决方法。首先，注意图像的当前大小。然后，将其重新缩放为 100%，并计算 100% 处的图像与原始大小的比例。更新链接后，重新应用该比率。不优雅，但效果很好，而且很快。

Sub testScale()
Dim objShape As Object
Dim sHeightOld As Variant
Dim sWidthOld As Variant
Dim tScaleWidth As Variant
Dim tScaleHeight As Variant
Set objShape = Application.ActiveWindow.Selection
sHeightOld = objShape.ShapeRange.Height
sWidthOld = objShape.ShapeRange.Width
            objShape.ShapeRange.ScaleWidth 1#, msoTrue
            objShape.ShapeRange.ScaleHeight 1#, msoTrue
tScaleHeight = sHeightOld / objShape.ShapeRange.Height
tScaleWidth = sWidthOld / objShape.ShapeRange.Width
    objShape.ShapeRange.LinkFormat.update
    objShape.ShapeRange.ScaleWidth tScaleWidth, msoTrue
    objShape.ShapeRange.ScaleHeight tScaleHeight, msoTrue
End Sub
于 2013-05-20T14:08:40.927 回答