使用Excel VBA将Word形状固定在页面上的确切位置

时间:2018-07-30 14:46:29

标签: excel vba excel-vba ms-word word-vba

我当前正在使用以下Excel VBA将1-3个形状粘贴到Word文档中所需的位置,但是,它们未固定在所需的位置,因此被移动了当我使用VBA添加更多文本时。

有没有一种方法可以添加到下面的代码中,从而以与右键单击形状并选择固定在页面上的位置相同的方式将形状固定到其粘贴位置,而不用移动文本。虽然代码足够灵活,但可以在稍后的几个步骤中针对第二或第三种形状执行相同的任务,而无需更改第一种形状的位置。

Dim appWord
Dim quoteWord
Dim wordSelection

Set appWord = CreateObject("Word.Application")
appWord.Visible = True

Set quoteWord = appWord.Documents.Add
Set wordSelection = appWord.Selection

...

Sheets("Quick Lookup").Shapes("QuoteProduct1Image").Copy
wordSelection.Range.PasteSpecial Link:=False, _
DataType:=wdPasteShape, _
Placement:=wdInLine, _
DisplayAsIcon:=False
Dim wdShape As Word.Shape
Set wdShape = quoteWord.Shapes(quoteWord.Shapes.Count)
wdShape.WrapFormat.Type = wdWrapSquare

**'!--fix shape1 in position here.**

 ...

'inserts more text and a table contouring to the image
 'product description text
 'With wordSelection
    .TypeParagraph
    .Font.Underline = False
    .Paragraphs.Alignment = 0
    .ParagraphFormat.SpaceAfter = 0
    .Font.Bold = True
    .TypeText ("Product Specs: " & ThisWorkbook.Sheets("Quick Lookup").Range("SelectedFolds") & " " & ThisWorkbook.Sheets("Quick Lookup").Range("SelectedCardSize"))
    .TypeParagraph
End With

 'insert Table
 ThisWorkbook.Sheets("Quick Lookup").Range("Product1Table").Copy
 wordSelection.Paste
 Application.CutCopyMode = False
 appWord.Activate

有想法吗?

2 个答案:

答案 0 :(得分:1)

为了将Shape固定到页面上的某个位置,必须应用相对于页面元素(而不是text元素)的RelavtiveVerticalPosition。例如:

wdShape.RelativeVerticalPosition = Word.wdRelativeVerticalPositionPage   'or
wdShape.RelativeVerticalPosition = Word.wdRelativeVerticalPositionMargin

您似乎正在使用早期绑定,因此上述方法可行。如果您使用的是后期绑定,则等效的Long值分别为1和0。

请注意,在Word中,Shape总是 锚定到某个Range,通常是最靠近您粘贴时所选内容的段落。形状将始终与其锚定的范围位于同一页面上。这意味着,如果编辑导致锚点移动到其他页面,则“形状”也将移动到该页面。无法将形状永久“锚定”到特定页面。

答案 1 :(得分:0)

我也一直在努力解决这个问题。我在页面上有一个形状我想将其设置为“在页面上固定位置”,就像您在文档设置中选择图像时所做的那样。我已经用谷歌搜索了这个问题,但我还没有找到一种方法来在代码中做到这一点。 这是我创建圆圈的代码,我只是想让它在添加文本或其他任何操作时不会移动。

Set BBB = ActiveDocument.Shapes.AddShape(Type:=msoShapeOval, Left:=450, Top:=0, Width:=100, Height:=100, Anchor:=Selection.Range)
    With BBB
        
        .RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
        .RelativeVerticalPosition = wdRelativeVerticalPositionLine
        .PictureFormat.TransparentBackground = False
        .Line.ForeColor.RGB = RGB(255, 0, 0)
        .TextFrame.TextRange.Font.Size = 52
        .TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphCentre
        .TextFrame.TextRange.Text = Trim(Str$(OverallScore))
        .Line.Visible = msoFalse
        .WrapFormat.Type = wdWrapSquare
        .Shadow.Visible = msoCTrue
        .ShapeStyle = msoShapeStylePreset34
    End With
Selection.Collapse (wdCollapseEnd)