PowerPoint vba 使用 Shape 對象而不是形狀名稱對形狀進行分組

Question

我寫了一些格式化文本的代碼。 如果用戶將 cursor 置於屬於一組形狀的形狀中，則代碼不起作用，解決方案是取消組合形狀。

我想在執行格式化代碼后重新組合形狀。

我能夠將底層形狀以及它們的名稱存儲為對象。 但是，通常的分組方法（使用形狀名稱）不起作用，因為在給定幻燈片上可以有這些形狀名稱的多個實例。 例如，這不起作用，因為幻燈片上可能有多個“文本框”實例：

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

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

但是，我將形狀對象存儲在一個數組中，其關鍵是這個（object '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

這是一些您可以修改為 function 的起始代碼，它將返回對包含當前選擇 cursor 的段落的引用。 當然，它並不真正需要所有 debug.print 的東西，但這可能有助於說明 object 層次結構：

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

Answer 2

不確定我是否完全理解問題，但這可能會有所幫助：

如果用戶在形狀中選擇了文本，那么該形狀是否屬於組並不重要。 您可能需要測試 .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