【问题标题】:Select and reposition and image in MS Word 2016在 MS Word 2016 中选择和重新定位和图像
【发布时间】:2020-11-02 01:01:12
【问题描述】:

我是一名科学作家。有时我在大型文档中执行重复性任务,并且每天有很多文档。一项任务是在每个页面中插入单个图像(不同页面的不同图像)并将图像放置在页面的左下方(页面右侧 0.45 英寸;页面顶部下方 10.35 英寸)。

我尝试在插入图像后录制一个简单的宏以在每个页面上使用,但 MS Word 不允许我在录制宏时选择图像。

我认为 VBA 可能会对我有所帮助,但我无法设想一种方法;我只有基本的VBA知识。我想“拍摄预选的图像并在页面内重新定位它。”

SatxJoe

【问题讨论】:

    标签: vba ms-word


    【解决方案1】:

    我通常会要求您表现出更多自己的努力,但我知道您不是软件工程师,并且处理图像很繁琐。我花了很长时间为我自己的应用程序解决这个问题。虽然看起来很简单,但不是我开始的时候。

    试试下面的入门工具包。您必须添加自己的错误处理以及所需的任何参数和逻辑。键盘快捷键也很方便。

    它假定图像不是内嵌图像(请参阅 Word 中的定位选项),而是“浮动”在页面上。这使得重新定位它成为可能。由于内联和非内联的代码不同,因此需要更多代码。我添加了特定的代码来获取选定的内联图像并使其非内联 - 但已注释掉。使用错误处理,您可以使代码适用于这两种情况。

    从您的描述看来,您似乎需要页脚中的图像,并且每个页面上都有不同的图像。这并不是那么简单——但最终是可行的。此代码只是将其重新定位在页面本身上。

    ' TO DO: add error handling. Code assumes that the selection is the image
    ' If it is not then an exception is thrown
    
    Dim selectedShape As Shape
    
    ' If the image is not an inline image
    Set selectedShape = ActiveDocument.Shapes(Selection.ShapeRange.Name)
    
    ' If the image is an inline image then
    ' Set selectedShape = Selection.InlineShapes(1).ConvertToShape
    
    With selectedShape
        ' Allow text to wrap around the image
        .WrapFormat.Type = WdWrapType.wdWrapFront
        
        ' Fix the anchor (more stable repositioning)
        .LockAnchor = True
        
        ' Size the picture
        .LockAspectRatio = True
        .Height = Application.InchesToPoints(1)
        
        ' Position the picture - use absolution position relative to page edges
        .RelativeHorizontalPosition = WdRelativeHorizontalPosition.wdRelativeHorizontalPositionPage
        .RelativeVerticalPosition = WdRelativeVerticalPosition.wdRelativeVerticalPositionPage
        .Top = Application.InchesToPoints(10.35)
        .Left = ActiveDocument.PageSetup.PageWidth - Application.InchesToPoints(0.45) - .Width
    End With
    

    【讨论】:

    • 感谢您抽出宝贵时间帮助我。我希望通读你的代码并学到一些东西。我也会用的。
    【解决方案2】:

    您的要求并不完全清楚,所以这是我的假设:

    1. 您在文档正文中插入图像,而不是在页脚中
    2. 图片需要左右对齐。

    如果这些假设是正确的,您只需稍作设置,无需使用任何代码即可实现您想要的。

    在该位置添加图片有三种方式:

    1. 添加浮动图片
    2. 在与左下角对齐的无边框浮动表格内添加内嵌图像。
    3. 在段落中添加内嵌图像,该段落的边框与左下角对齐。

    最后两个选项可以使用图片内容控件代替图片提前设置并保存为快速部件/构建块。然后,当您需要添加图片时,您只需插入快速部件并将图片添加到其中。

    如果您确实需要添加带有特定图像的页脚,您还可以通过将页脚保存在页脚库中来简化操作。

    编辑: 如果您对编码解决方案感到满意,那么我建议您不要使用代码来解决问题,而是使用它来防止出现问题,即您使用插入和放置图像的代码。下面的第一个例程将执行此操作。作为奖励,还有一个移动选定图像的例程。只需将以下所有代码复制并粘贴到新模块中即可。

    Option Explicit
    
    Public Sub InsertPictureBottomLeft()
       Dim location As Range
       Set location = Selection.Range
       
       Dim filename As String
       filename = GetPictureFileName
       If filename = vbNullString Then Exit Sub
       
       Dim picture As Shape
       'add the picture
       Set picture = _
          ActiveDocument.Shapes.AddPicture(filename:=filename, _
          LinkToFile:=False, SaveWithDocument:=True, Anchor:=location)
       LayoutPictureBottomLeft picture
    End Sub
    
    Public Sub MoveSelectedPictureBottomLeft()
       Dim picture As Shape
    
       On Error Resume Next
       Set picture = Selection.ShapeRange(1)
       'if selected picture is InlineShape we get an error
       If Err Then Set picture = Selection.InlineShapes(1).ConvertToShape
       'reset error handling
       On Error GoTo 0
       LayoutPictureBottomLeft picture
    End Sub
    
    Private Function GetPictureFileName() As String
       Dim dlgPicture      As Word.Dialog
       'display the picture dialog
       Set dlgPicture = Dialogs(wdDialogInsertPicture)
       With dlgPicture
          .Display
          GetPictureFileName = .Name
       End With
    End Function
    
    Private Sub LayoutPictureBottomLeft(picture As Shape)
       With picture
          .LayoutInCell = True
          .LockAspectRatio = msoTrue
          .WrapFormat.Type = wdWrapTopBottom
          .Left = wdShapeLeft
          .RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
          .Top = wdShapeBottom
          .RelativeVerticalPosition = wdRelativeVerticalPositionMargin
          'for placement relative to page comment out previous 4 lines
          'and uncomment next 4 lines
          '.Left = InchesToPoints(0.45)
          '.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
          '.Top = InchesToPoints(10.35)
          '.RelativeVerticalPosition = wdRelativeVerticalPositionPage
       End With
    End Sub
    

    【讨论】:

    • 谢谢。我期待着尝试一下。而且,我期待着研究你所做的并从中学习。感谢您花时间帮助我。
    猜你喜欢
    • 2021-07-24
    • 2019-11-07
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2019-03-06
    • 2019-10-09
    相关资源
    最近更新 更多