我看了你的代码，问题主要出在几个类的属性定义、对象实例化的细节上，导致你存入的数据无法正确读取。咱们一步步拆解并修正：

1. shapesOnSlide类中aShape属性的笔误+对象赋值缺失 #

你在aShape的Get属性里写错了变量名，而且因为shapeDetails是对象类型，赋值时必须用Set关键字，这直接导致获取不到存入的形状数据：

' 错误写法
Public Property Get aShape() As Variant
    shapes = allShapes(collectionSize)
End Property

Public Property Let aShape(value As Variant)
    allShapes(collectionSize) = value
End Property

修正后：

Public Property Get aShape() As shapeDetails
    Set aShape = allShapes(collectionSize)
End Property

Public Property Let aShape(value As shapeDetails)
    Set allShapes(collectionSize) = value
End Property

同时建议把allShapes的类型从Variant改为shapeDetails，让类型更明确：

Private allShapes(99999) As shapeDetails ' 替换原Variant类型

2. 循环中实例化shapeDetails的方式错误 #

在遍历形状的循环里，你用了Dim currentShape As New shapeDetails，VBA中As New是延迟实例化，这会导致每次循环复用同一个shapeDetails对象，之前存入的数据会被覆盖。应该改成先声明变量，再手动创建新实例：

' 替换原代码中的Dim currentShape As New shapeDetails
Dim currentShape As shapeDetails
Set currentShape = New shapeDetails

3. Presentation类printAll方法的遍历逻辑问题 #

原方法直接遍历整个everyShape数组，但数组里大部分是无效空值，应该根据shapesOnSlide的size来循环有效元素。我们可以给shapesOnSlide添加一个获取指定索引形状的方法，再修改遍历逻辑：

给shapesOnSlide添加方法：

Public Function GetShape(index As Integer) As shapeDetails
    If index >= 0 And index <= collectionSize Then
        Set GetShape = allShapes(index)
    Else
        Set GetShape = Nothing
    End If
End Function

修改Presentation的printAll方法：

Public Sub printAll()
    Dim slideIndex As Integer
    Dim shapeIndex As Integer
    For slideIndex = LBound(allSlides) To UBound(allSlides)
        Dim currentSlide As shapesOnSlide
        Set currentSlide = allSlides(slideIndex)
        If Not currentSlide Is Nothing Then
            ' 只循环有效形状（从0到currentSlide.size）
            For shapeIndex = 0 To currentSlide.size
                Dim currentShape As shapeDetails
                Set currentShape = currentSlide.GetShape(shapeIndex)
                If Not currentShape Is Nothing Then
                    currentShape.PrintVars ' 用你已写好的PrintVars更直观
                End If
            Next shapeIndex
        End If
    Next slideIndex
End Sub

完整修正后的核心代码片段 #

Module 1循环部分：

For Each oPPSlide In oPPPrsn.Slides
    Dim currentSlide As New shapesOnSlide
    Dim numShapes As Integer
    numShapes = 0
    For Each oPPShape In oPPSlide.Shapes
        Dim currentShape As shapeDetails
        Set currentShape = New shapeDetails
        currentShape.slideNumber = oPPSlide.SlideNumber
        currentShape.name = oPPShape.name
        currentShape.left = oPPShape.Left
        currentShape.top = oPPShape.Top
        currentSlide.size = numShapes
        currentSlide.aShape = currentShape
        numShapes = numShapes + 1
    Next
    currentPresentation.Slide(numSlides) = currentSlide
    numSlides = numSlides + 1
Next

额外提示 #

• 处理VBA对象类型时，必须用Set关键字完成赋值，这是很多新手容易忽略的点，也是你数据丢失的关键原因之一。
• 可以在类的初始化里做一些边界处理，比如shapesOnSlide初始化时把collectionSize设为-1，避免初始空值干扰。

这样修改后，你应该就能正确存储和读取每张幻灯片的形状坐标数据了。

内容的提问来源于stack exchange，提问作者BeastInTeeth