我绘制的形状没有保留在其预期位置

Question

Word 的 VBA 宏。我有一张 15 X 3 的桌子。在单元格(3,3) 中，我合并了 9 行。在合并的单元格中，我必须编写“文本 1”，移动到下面的段落并绘制一个矩形（高度 10，宽度 100，颜色）。在其上超级施加另一个矩形，相同的 x、y 位置、相同的高度，但宽度为 25%，颜色为白色。我这样做了 3 次，一个比另一个低。我面临的问题是颜色矩形跳转到单元格（3,1），白色保留在单元格（3,3）中，但当我将其放入循环中时它也会消失。我想对矩形进行分组并将它们锚定到合并单元格 (3,3) 中的位置。 我将非常感谢任何帮助

Sub DrawSkillLevelCharts(StartRow, StartColumn, paraNo, I)
    Dim leftPos As Single
    Dim topPos As Single
    Dim chartWidth As Single
    Dim barHeight As Single
    Dim superWidth As Single
    Dim startCell As cell
    Dim currentRange As Range
    Dim mainBarChart As Shape
    Dim superimposedBar As Shape
        barHeight = 10
        Set currentRange = myTable.cell(StartRow, StartColumn).Range.Paragraphs(paraNo).Range

            With currentRange
                .Collapse 0
                .Move Unit:=wdCharacter, Count:=1
                .Select
            End With
            leftPos = Selection.Information(wdHorizontalPositionRelativeToPage)
            topPos = Selection.Information(wdVerticalPositionRelativeToPage)
            chartWidth = 100
            superWidth = chartWidth * (I * 0.25)
            
            ' Draw main bar chart and anchor it to the cell
            Set mainBarChart = ActiveDocument.Shapes.AddShape(msoShapeRectangle, leftPos, topPos, _ chartWidth, barHeight, currentRange)
            mainBarChart.Fill.ForeColor.RGB = RGB(56, 86, 35)
            mainBarChart.Anchor = currentRange
            ' Draw superimposed white bar and anchor it to the cell
            Set superimposedBar = ActiveDocument.Shapes.AddShape(msoShapeRectangle, leftPos, topPos, _ superWidth, barHeight, currentRange)
            superimposedBar.Fill.ForeColor.RGB = RGB(255, 255, 255)
            superimposedBar.Anchor = currentRange
End Sub

Answer 1

与 Excel 相比，使用 VBA 将形状插入 Word 表格更为复杂。需要调整一些参数才能正确定位形状。

Option Explicit
Sub DrawSkillLevelCharts()
    Dim leftPos As Single
    Dim topPos As Single
    Dim chartWidth As Single
    Dim barHeight As Single
    Dim superWidth As Single
    Dim startCell As Cell
    Dim currentRange As Range
    Dim mainBarChart As Shape
    Dim superimposedBar As Shape
    Dim cellFirst, cellDest, myTable, j, sTxt
    ' ****************
    Dim StartRow, StartColumn, paraNo, I
    ' Parameters from caller
    StartRow = 3:    StartColumn = 3
    paraNo = 2:     I = 1
    barHeight = 13
    ' ****************
    Set myTable = ActiveDocument.Tables(1)
    Set cellFirst = myTable.Cell(1, 1).Range
    Set cellDest = myTable.Cell(StartRow, StartColumn)
    sTxt = "Text1"
    For j = 1 To paraNo
        sTxt = sTxt & vbCr
    Next j
    With cellDest.Range
        ' Update content in the merged cell
        .Text = sTxt
        .Collapse direction:=wdCollapseStart
        ' Move to target paragraph
        .Move Unit:=wdParagraph, Count:=paraNo - 1
        .Select
    End With
    'LeftPadding is used to adjust the Left pos
    leftPos = Selection.Information(wdHorizontalPositionRelativeToPage) - cellDest.LeftPadding
    topPos = Selection.Information(wdVerticalPositionRelativeToPage)
    chartWidth = 100
    superWidth = chartWidth * (I * 0.25)
    ' Draw main bar chart and anchor it to the cell
    Set mainBarChart = ActiveDocument.Shapes.AddShape(msoShapeRectangle, _
        leftPos, topPos, chartWidth, barHeight, cellFirst)
    mainBarChart.Fill.ForeColor.RGB = RGB(56, 86, 35)
    ' Draw superimposed white bar and anchor it to the cell
    Set superimposedBar = ActiveDocument.Shapes.AddShape(msoShapeRectangle, _
        leftPos, topPos, superWidth, barHeight, cellFirst)
    superimposedBar.Fill.ForeColor.RGB = RGB(255, 255, 255)
End Sub

输出