使用 Application.CommandBar.ExecuteMSO 使用 VBA 更改 Table 单元格内的字体轮廓颜色

Question

Win10x64 Office 365 PPT v 16.0.12325.202080 64 位

为了便于阅读，我需要显示一个字体颜色为黄色但轮廓为黑色的字符。此角色进入 Powerpoint table 单元格。

下面的 link 有一个我目前正在使用的方法，包括创建一个虚拟形状，向其中添加文本，修改形状的 textframe2 textrange 字体行属性，然后将其复制并粘贴回去到 table 单元格。

http://www.vbaexpress.com/forum/archive/index.php/t-43787.html

这是 8 年前提出的问题，但我目前看到了相同的行为，即我们无法直接操作单元格内文本的 textframe2 艺术字格式。该程序未显示错误但无法运行。

我已经放弃尝试直接从 VBA 修改 textrame2 textrange 字体行属性。

我已经设法让它激活字体轮廓颜色使用 Application.CommandBars.ExecuteMso ("TextOutlineColorPicker")

激活后我想我可以修改textframe2 textrange 字体行属性，但还是不行。

是否有 Application.CommandBars idMso 用于更改 table 单元格内的字体轮廓颜色和字体轮廓线宽？

或者除了将格式化文本粘贴到 table 单元格之外的另一个方法。

编辑：添加图像来说明我所说的文本颜色和文本轮廓颜色以及用于以红色圆圈显示它们的菜单：

编辑2 添加了另一个快照，以举例说明单元格内有黑色轮廓的字符和单元格内没有轮廓的字符

谢谢

Answer 1

这是一个访问给定幻灯片上的 Table 并更改一个单元格属性的示例。我使用的示例幻灯片如下所示

代码本身创建了一个函数，允许您从特定幻灯片 select table 和 table 中的单个单元格并突出显示它。

Option Explicit

Sub test()
    HighlightTableCell 1, 2, 3
End Sub

Sub HighlightTableCell(ByVal slideNumber As Long, _
                       ByVal thisRow As Long, _
                       ByVal thisCol As Long)
    Dim theSlide As Slide
    Set theSlide = ActivePresentation.Slides(slideNumber)

    Dim shp As Shape
    For Each shp In theSlide.Shapes
        If shp.Type = msoTable Then
            Dim theTable As Table
            Set theTable = shp.Table
            With theTable.Cell(thisRow, thisCol)
                With .Shape.TextFrame2.TextRange.Characters.Font.Fill
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(255, 255, 0)
                    .Transparency = 0
                    .Solid
                End With
                With .Shape.TextFrame2.TextRange.Characters.Font.Line
                    .Visible = msoTrue
                    .ForeColor.ObjectThemeColor = msoThemeColorText1
                    .ForeColor.TintAndShade = 0
                    .ForeColor.Brightness = 0
                    .Transparency = 0
                End With
            End With
        End If
    Next shp
End Sub

Answer 2

这个问题应该由 Microsoft Office 开发人员来回答。目前，为了克服这种 bug-some 情况，我认为，复制 table 之外的格式化文本并将其粘贴到 table 单元格中是解决此问题的唯一 work-around。

正如您所提到的，根据最出色的 PowerPoint MVP 之一约翰·威尔逊 (http://www.vbaexpress.com/forum/archive/index.php/t-43787.html) 的说法，如果我们从位于 table 之外的文本框或形状复制文本, 即使 table 单元格中的文本也可以保留文本格式。

Option Explicit

Sub test()

Dim shp As Shape, tshp As Shape
Dim sld As Slide
Dim tbl As Table
Dim r%, c%

If ActiveWindow.Selection.Type = ppSelectionNone Then MsgBox "Select a table first.": Exit Sub
Set shp = ActiveWindow.Selection.ShapeRange(1)
Set sld = shp.Parent

'add a temporary textbox for copying the formatted text into a cell
Set tshp = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 541, 960, 540)
tshp.Visible = False

Set tbl = shp.Table
For r = 1 To tbl.Rows.Count
    For c = 1 To tbl.Columns.Count
        '1) cell -> 'tshp'
        tbl.Cell(r, c).Shape.TextFrame2.TextRange.Copy
        tshp.TextFrame2.TextRange.Paste
        
        '2) outline the text in 'tshp'
        With tshp.TextFrame2.TextRange.Font.Line
            .Visible = msoTrue
            .Weight = 0.2
            .ForeColor.RGB = RGB(255, 127, 127)
        End With
        
        '3) 'tshp' -> cell
        tshp.TextFrame2.TextRange.Copy
        tbl.Cell(r, c).Shape.TextFrame2.TextRange.Paste
        
        '// the code below doesn't work
        'With tbl.Cell(r, c).shape.TextFrame2.TextRange.Characters.Font.Line
        'With tbl.Cell(r, c).shape.TextFrame2.TextRange.Font.Line
        '    .Visible = msoTrue
        '    .Weight = 0.5
        '    .ForeColor.RGB = RGB(255, 127, 127)
        'End With
    Next c
Next r

'remove the tempoarary textbox
tshp.Delete

End Sub

上面的代码片段在幻灯片的 left-top 区域创建了一个临时文本框，并应用了轮廓文本格式。然后，它将每个单元格的内容复制到临时文本框，并将格式化文本 copy/paste 复制回单元格。通过使用这种方法，我们可以将轮廓文本格式应用于单元格中的文本。

使用 Application.CommandBar.ExecuteMSO 使用 VBA 更改 Table 单元格内的字体轮廓颜色

Changing Font Outline color inside a Table Cell with VBA using Application.CommandBar.ExecuteMSO

powerpoint

vba

office365