Powerpoint VBA使複製形狀視圖處於活動狀態以選擇分組

Question

我的PowerPoint幻燈片上有8個圖像庫。根據用戶表單輸入，通過在原始圖像名稱後面添加「1」或「2」以使它們可區分，某些組件得到複製和重命名。然後，我想分組新圖像（我正在構建組件圖像中的項目）。我能夠複製圖像並將它們排列正確，但我在分組時遇到問題。請注意，我並不總是將相同數量的項目分組，而是依賴於用戶輸入。

我收到錯誤「Shape（unknown member）：無效的請求。要選擇一個形狀，它的視圖必須是活動的。」

我搜索並試圖從幫助論壇實施幾個策略，但我是空的。

請幫助！ -Kevin

的下面的代碼部分，因爲它是很長，但是這是我的第一個問題就出現了：

Dim Cargo As Shape, Cargo_Dup as Shape, Chemical as Shape, Chemical_Dup as Shape 
Set Cargo = ActivePresentation.Slides(2).Shapes("Cargo") 
Set Chemical = ActivePresentation.Slides(2).Shapes("Chemical") 
Cargo.Name = "Cargo" 
Chemical.Name = "Chemical" 

With ActivePresentation 
Set Cargo_Dup = ActivePresentation.Slides(2).Shapes("Cargo") 
    With Cargo_Dup.Duplicate 
     .Name = "Cargo_1st" 
     .Left = 0 
     .Top = 540 
    End With 
'CHEMICAL 
If Input1 = "Chemical" Then 
    Set Chemical_Dup = ActivePresentation.Slides(2).Shapes("Chemical") 
     With Chemical_Dup.Duplicate 
      .Name = "Chemical" & 1 
      .Left = 36.74352 
      .Top = 540 + 0.36 
     End With 
    '''''WHERE PROBLEM ARISES''''' 
    ActivePresentation.Slides(2).Shapes("Cargo_1st").Select 
    ActivePresentation.Slides(2).Shapes("Chemical1").Select msoFalse 
    Set Vehicle = ActiveWindow.Selection.ShapeRange.Group 
    Vehicle.Name = "Vehicle" 
'Elseif with a bunch for options where addition grouping occurs 

Answer 1

我需要某種形式的鍵盤宏爲我輸入：

絕對不要選擇任何東西，除非你絕對必須。 你幾乎從不絕對必須。

您在問如何使視圖處於活動狀態，以便您可以選擇某些內容。 我認爲這是一個錯誤的問題。
知道如何使用形狀而不必選擇它們會更有用。 分組形狀沒有選擇它們有點棘手，但它可以完成。

這裏是你怎麼可能去這樣一個例子：

Sub GroupWithoutSelecting() 

    Dim oSl As Slide 
    Dim oSh As Shape 
    Dim aShapes() As String 

    Set oSl = ActivePresentation.Slides(2) ' or whichever slide you like 
    ReDim aShapes(1 To 1) 

    With oSl 
     For Each oSh In .Shapes 
      If oSh.Type <> msoPlaceholder Then ' can't group placeholders 

       ' Substitute the real condition you want to use 
       ' for selecting shapes to be grouped here 
       If oSh.Type = msoAutoShape Then 
        ' add it to the array 
        aShapes(UBound(aShapes)) = oSh.Name 
        ReDim Preserve aShapes(1 To UBound(aShapes) + 1) 
       End If 

      End If 
     Next 

     ' eliminate the last (empty) element in the array 
     ReDim Preserve aShapes(1 To UBound(aShapes) - 1) 

     ' Create a shaperange from the array members and group the shaperange 
     .Shapes.Range(aShapes).Group 

    End With ' oSl 

End Sub