PowerPoint vba 使用形状对象而不是形状名称对形状进行分组

Question

我写了一些格式化文本的代码。如果用户将光标放在属于一组形状的形状中，则代码不起作用，解决方案是取消组合形状。

我想在执行格式化代码后重新组合形状。

我能够将底层形状及其名称存储为对象。但是，通常的分组方法（使用形状名称）不起作用，因为在给定的幻灯片上可能有这些形状名称的多个实例。例如。这不起作用，因为幻灯片上可能有多个“文本框”实例：

Set TempShapeGroup = TempSlide.Shapes.Range(Array("textbox", "header", "separator")).Group

https://docs.microsoft.com/en-us/office/vba/api/powerpoint.shaperange.group

但是，我将形状对象存储在一个数组中，其关键在于（对象 'TempShape' 是一组形状）：

Dim ShapesArray()               As Shape
ReDim ShapesArray(1 To TempShape.GroupItems.Count)

For i = 1 To TempShape.GroupItems.Count
    Set ShapesArray(i) = TempShape.GroupItems.Item(i)
Next i

所以，我想做的是使用形状对象数组重新创建形状组，所以达到以下效果的东西是理想的：

Set MyShapesGroup= ShapesArray.Group

但是使用 Shape 对象对形状进行分组的任何方式都可以。

TIA

Answer 1

不确定我是否完全理解问题，但这可能会有所帮助：

如果用户选择了形状内的文本，则该形状是否属于某个组并不重要。您可能需要测试 .Selection.Type 并根据 .Type 是文本还是 shaperange 以不同方式处理事情。示例：

Sub FormatCurrentText()

If ActiveWindow.Selection.Type = ppSelectionText Then

    With ActiveWindow.Selection.TextRange
        .Font.Name = "Algerian"
    End With

End If

End Sub

Answer 2

这是一些起始代码，您可以将其修改为一个函数，该函数将 return 引用包含当前选择光标的段落。当然，它并不真的需要所有 debug.print 东西，但这可能有助于说明对象层次结构：

Sub WhereIsTheCursor()

Dim oRng As TextRange
Dim oParentRange As TextRange
Dim x As Long
Dim lSelStart As Long
Dim lSelLen As Long

With ActiveWindow.Selection.TextRange
    ' find the selection start relative to first character in shape
    lSelStart = .Start
'    lSelLen = .Length
    
    Debug.Print TypeName(.Parent)
    Debug.Print TypeName(.Parent.Parent)
    Debug.Print TypeName(.Parent.Parent.Parent)
    Debug.Print .Paragraphs.Count
    Set oRng = .Characters(.Start, .Length)
    Debug.Print oRng.Text
    
    ' Reference the overall shape's textrange
    Set oParentRange = .Parent.Parent.TextFrame.TextRange
    
    ' For each paragraph in the range ...
    For x = 1 To oParentRange.Paragraphs.Count
    
        ' is the start of the selection > the start of the paragraph?
        If lSelStart > oParentRange.Paragraphs(x).Start Then
            ' is the start < the start + length of the paragraph?
            If lSelStart < oParentRange.Paragraphs(x).Start _
               + oParentRange.Paragraphs(x).Length Then
               ' bingo!
               MsgBox "The cursor is in paragraph " & CStr(x)
            End If
        End If
    
    Next
    
End With

End Sub

PowerPoint vba 使用形状对象而不是形状名称对形状进行分组

PowerPoint vba group shapes using Shape objects, not shape names

powerpoint

grouping

vba

shapes