Arrays 根据条件向数组中添加幻灯片编号

我正处于脱发阶段，我承认我需要一个比我更有知识和理解力的人来推动这件事

这是一个由两部分组成的问题-第一部分是关于这个代码的，但是第二个问题是，我是否以正确的方式来处理这个问题？不管怎样，我还是很想找出我的代码出了什么问题，这样我就能做得更好

所需的代码目标：搜索演示文稿中的每张幻灯片，在同一张幻灯片上查找名为“更新”的形状和另一个名为“每月”或“每周”的形状（例如）。一旦它找到这些形状，我将运行一段单独的代码来操作特定的幻灯片（这段代码已经完成，工作非常完美）

我的预期解决方案：首先在每张幻灯片中循环查找名为“更新”的形状。当需要时，此形状将始终出现在幻灯片上，但“每月”/“每周”形状是一个名称，它会根据所需的更新频率进行更改。找到“更新”形状后，将该幻灯片编号添加到数组中。完成整个演示后，再次检查阵列中的幻灯片，查看是否存在名为“每月”、“每周”等的形状，并相应地调用代码

我的问题：代码确实成功找到了名为“Update”的形状，但我无法确定如何将幻灯片编号放入数组中

Sub New_test()
' Code objectives:
' Figure out which slide has the shape named "Update"
' Add that slide to an array with the corresponding slide number in
' Loop through each slide in that array, see if slide contains the shape named "Monthly"
' If so, run another macro

Dim myArr() As Variant
Dim oShape As Shape
Dim i As Long, j As Long

ReDim myArr(0)

For i = 1 To ActivePresentation.Slides.Count
    For Each oShape In ActivePresentation.Slides(i).Shapes
        If oShape.Name = "Update" Then
            ReDim Preserve myArr(UBound(myArr) + 1)                     'Redim the size of the array
            j = j + 1
            For j = LBound(myArr) To UBound(myArr)                      'Begin looping through the array
                myArr(j) = ActivePresentation.Slides(i).SlideNumber     'Assign SlideNumber value to array
            Next j
        End If
    Next oShape
Next i

For i = 0 To UBound(myArr)
    Debug.Print "Array:"; myArr(i)
Next i
 
End Sub

此代码可以工作，但它使数组的每个元素都等于最终幻灯片编号。因此，例如，如果一个演示文稿有3张带“update”的幻灯片，最后一张幻灯片的编号是7，那么数组将返回数组（0）=7，数组（1）=7，数组（2）=7。正如我所介绍的，它正在正确地重新确定阵列大小，并使用正确的幻灯片编号，直到找到带有“update”的下一张幻灯片，然后它会覆盖自身，并为阵列的每个部分使用新的幻灯片编号

Sub New_test()
' Code objectives:
' Figure out which slide has the shape named "Update"
' Add that slide to an array with the corresponding slide number in
' Loop through each slide in that array, see if slide contains the shape named "Monthly"
' If so, run another macro

Dim myArr() As Variant
Dim oShape As Shape
Dim i As Long, j As Long

ReDim myArr(0)

For i = 1 To ActivePresentation.Slides.Count
    For Each oShape In ActivePresentation.Slides(i).Shapes
        If oShape.Name = "Update" Then
            ReDim Preserve myArr(UBound(myArr) + 1)                     'Redim the size of the array
            j = j + 1
            For j = LBound(myArr) To UBound(myArr)                      'Begin looping through the array
                myArr(j) = ActivePresentation.Slides(i).SlideNumber     'Assign SlideNumber value to array
            Next j
        End If
    Next oShape
Next i

For i = 0 To UBound(myArr)
    Debug.Print "Array:"; myArr(i)
Next i
 
End Sub

最后一个问题-我这样做对吗？ 这段代码是在我花了很长时间试图想出一种方法来实现这一点之后产生的，在我看来这是最明智的方法，然而，我完全是自学成才的，并且只经常使用VBA一年，所以我意识到我可能还没有像程序员那样思考

---

我最初尝试执行一个非常简单的“For each”循环，但在找到名为“Update”的形状后，我无法想出如何使代码通过幻灯片循环回来，然后根据第二个形状是否在名为“Monthly”的幻灯片上的情况采取相应的行动，“每周”等。如果您对我没有想到的其他方法有任何建议，我将不胜感激。

要回答当前的问题，请更改以下内容：

For i = 1 To ActivePresentation.Slides.Count
    For Each oShape In ActivePresentation.Slides(i).Shapes
        If oShape.Name = "Update" Then
            ReDim Preserve myArr(UBound(myArr) + 1)                     'Redim the size of the array
            j = j + 1
            For j = LBound(myArr) To UBound(myArr)                      'Begin looping through the array
                myArr(j) = ActivePresentation.Slides(i).SlideNumber     'Assign SlideNumber value to array
            Next j
        End If
    Next oShape
Next i

为此：

    For i = 1 To ActivePresentation.Slides.Count
        For Each oShape In ActivePresentation.Slides(i).Shapes
            If oShape.Name = "Update" Then
                If ExistSpecialShape(ActivePresentation.Slides(i) then
                    ReDim Preserve myArr(UBound(myArr) + 1)                     'Redim the size of the array
                End if
' Your original loop was assigning the value of J to every element in the array
' every time you invoked the loop; that's why you filled it with the last slide number
' And use SlideIndex rather than SlideNumber.
' SlideNumber is the number that appears on printouts and such.
' Normally it's the same as SlideIndex, but if the user has chosen to start
' slide numbering at something other than 1, your results will be cockeyed.
' SlideIndex won't change in that situation.
                myArr(Ubound(myArr)) = ActivePresentation.Slides(i).SlideIndex    'Assign SlideNumber value to array
            End If
        Next oShape
    Next i

在该子例程的结束子例程之后，添加

ExistSpecialShape（oSl作为幻灯片）作为布尔值 暗淡的oSh形状 对于oSl形状中的每个oSh 选择Case oSh.Name 情况是=“星期一” ExistSpecialShape=True 退出功能 情况是“星期三” ExistSpecialShape=True 退出功能 '依此类推，每个要测试的形状名称对应一个大小写 结束选择 下一个 端函数

另一个要考虑的是，用户可以很容易地使用选择窗格来改变形状的名称，如果用户使用了形状，PPT可以在添加相同名称的多个形状时草率。

您可能需要仔细阅读标签。比形状名称更可靠，更灵活，用户无法访问

我在这里维护的PPT FAQ中有一些关于标签的基本信息： 使用标记（以及一些函数）

---

非常感谢您-这非常有效！如果你不介意的话，我有一个简短的问题？你说我们可以先检查一个项目，然后再检查下一个项目，然后再添加到数组中——这是我的偏好，但我做得不对，因为我没有得到应有的结果。我想我会在第一个语句之后添加一个额外的“IF”语句，但有不同的标准，但这不会给我任何结果。还感谢您提供有关标签的提示；我将很快使用这些，但现在形状名称是足够的，因为这只是为我，所以不必担心它的变化。另外，我喜欢PPTFAQ网站！不客气，很高兴你喜欢PPTFAQ；多年来，这是一项爱的劳动。看看我刚才对原始答案所做的修改。