在 Word 文件中保持图片比例

Question

我通过 VBA 在 Word 文档的左页眉单元格中添加了一张图片 - 使用以下代码可以正常工作。现在我想保持图片的比例，但想改变大小，我不知道怎么做：

Sub AutoOpen()

Dim dd1 As Document: Set dd1 = ActiveDocument
Dim rng1 As Range, seC As Section, an(2) As Long
Dim rngO As Range, rngAN As Range
Dim strToPict As String
    
For Each rngO In dd1.StoryRanges

ActiveDocument.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

If rngO.StoryType = wdEvenPagesHeaderStory Then
Set rng1 = rngO.Duplicate
For Each seC In rng1.Sections
    an(0) = seC.Headers(1).Range.InlineShapes(1).Height
    an(1) = seC.Headers(1).Range.InlineShapes(1).Width
    Set rngAN = seC.Headers(1).Range.InlineShapes(1).Range.Duplicate
    seC.Headers(1).Range.InlineShapes(1).Delete
    seC.Headers(1).Range.InlineShapes.AddPicture FileName:=strToPict, _
    LinkToFile:=False, SaveWithDocument:=True, Range:=rngAN

        With seC.Headers(1).Range.InlineShapes(1)
         .Height = 50
         .LockAspectRatio = True
        
        End With
Next

Dim i As Long

ActiveDocument.Save
'Footer changing'
For i = 1 To ActiveDocument.Sections.Count
    With ActiveDocument.Sections(i)
        .Footers(wdHeaderFooterPrimary).Range.Text = ActiveDocument.Name + "Text"
    End With
Next

End If

Next
 
End Sub

编辑：我发布了 Makro 的全部代码。

Answer 1

«我通过 VBA 在 Word 文档的左页眉单元格中添加图片»。 Word 文档中没有“左页眉单元格”之类的东西。 Word 仅有的页眉（和页脚）是主页、首页和偶数页。

而且，正如 Timothy 所说，您“真的需要学会使用触手可及的工具”。此外，在找到 LockAspectRatio 后，一个简单的网络搜索（如果真的有必要的话）将向您展示如何使用它。

在任何情况下，由于您似乎想要做的只是调整 inlineshape 的大小并重复主页面标题，您可以使用以下内容：

Sub AutoOpen()
Application.ScreenUpdating = False
Dim Rng As Range, iShp As InlineShape, Sctn As Section, StrNm As String
With Dialogs(wdDialogInsertPicture)
  .Display
  StrNm = .Name
End With
With ActiveDocument
  If StrNm <> "" Then
    Set Rng = .Sections.First.Headers(wdHeaderFooterPrimary).Range.Tables(1).Cell(1, 1).Range
    Set iShp = .InlineShapes.AddPicture(FileName:=StrNm, _
      LinkToFile:=False, SaveWithDocument:=True, Range:=Rng)
    With iShp
      .LockAspectRatio = True
      .Height = 50
    End With
  End If
  Set Rng = .Sections.First.Footers(wdHeaderFooterPrimary).Range
  .Fields.Add Range:=Rng, Type:=wdFieldEmpty, Text:="FILENAME", PreserveFormatting:=False
  Rng.InsertAfter vbTab & "Text"
  For Each Sctn In .Sections
    Sctn.Headers(wdHeaderFooterPrimary).LinkToPrevious = True
    Sctn.Footers(wdHeaderFooterPrimary).LinkToPrevious = True
  Next
End With
Application.ScreenUpdating = True
End Sub

Answer 2

您确实需要学习使用触手可及的工具 - IntelliSense、对象浏览器和在线帮助。

滚动浏览 IntelliSense 为您提供的选项，或在对象浏览器中查找 InlineShape，您会找到 LockAspectRatio。如果您不确定这是否是您所需要的，按F1 会将您转到online help。