Question

我的PowerPoint幻灯片上有一个包含八个图像的库。根据用户表单输入，通过在原始图像的名称后面添加“1”或“2”来复制和重命名某些组件，以使它们可以区分。然后我想分组新图像（我正在从组件图像中构建项目）。我能够复制图像并将它们正确排列，但我无法对它们进行分组。请注意，我并不总是将相同数量的项目分组，而是取决于用户输入。

我收到错误“Shape（未知成员）：无效请求。要选择形状，其视图必须处于活动状态。”

我搜索并试图从帮助论坛实施几个策略，但我现在空了。

请帮助!!! -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

Powerpoint VBA激活重复的形状视图以选择分组

1 个答案: