Почему мой массив очищается?

Question

Я разрабатываю слайд-чекер, чтобы искать несоответствующие шрифты и цвета, и нужно отслеживать каждый цвет для каждой фигуры в массиве. Моя проблема в том, что по какой-то причине массив get очищается. Я установил флажки, чтобы проверить правильность назначения массива. Когда он перемещается по контуру, он правильно добавляет 1 к массиву, обновляет цвет для этого индекса и затем продвигается вперед. По какой-то причине, когда он попадает на проверку msgbox, массив по-прежнему имеет правильное количество индексов, но массив пуст для каждой фигуры, за исключением последней фигуры в цикле. Например, одна форма имеет 5 строк, другая форма - 2. Я получу msgbox 7 раз, но первые 5 пустые, а следующие 2 имеют фактический цвет.

Private Sub CommandButton1_Click() 

Dim x As Integer 
Dim i As Integer 
Dim a As Integer 
Dim b As Integer 

Dim shpCount As Integer 

Dim lFindColor As Long 
Dim oSl As Slide 
Dim oSh As Shape 

Dim colorsUsed As String 
Dim fontsUsed As String 

Dim lRow As Long 
Dim lCol As Long 

Dim shpFont As String 
Dim shpSize As String 
Dim shpColour As String 
Dim shpBlanks As Integer: shpBlanks = 0 
Dim oshpColour() 

Set oSl = ActiveWindow.View.Slide 

    For Each oSh In oSl.Shapes 
    '----Shape Check---------------------------------------------------------- 
     With oSh 
      If .HasTextFrame Then 
       If .TextFrame.HasText Then 
       shpCount = shpCount + .TextFrame.TextRange.Runs.Count 
       ReDim oshpColour(1 To shpCount) 
        For x = 1 To .TextFrame.TextRange.Runs.Count 
         a = a + 1 
         oshpColour(a) = .TextFrame.TextRange.Runs(x).Font.Color.RGB 
         shpFont = shpFont & .TextFrame.TextRange.Runs(x).Font.Name & ", " 
         shpSize = shpSize & .TextFrame.TextRange.Runs(x).Font.Size & ", " 
         shpColour = shpColour & .TextFrame.TextRange.Runs(x).Font.Color.RGB & ", " 
        Next 
       End If 
      End If 
    Next 

MsgBox "Shape Fonts: " & shpFont & vbCrLf & "Shape Font Sizes: " & shpSize & vbCrLf & "Shape Font Colours: " & shpColour 

For b = LBound(oshpColour) To UBound(oshpColour) 
MsgBox oshpColour(b) 
Next 

End Sub 

Answer 1

Правильный путь ReDim массив, сохраняя его содержание следующим образом:

ReDim Preserve oshpColour(1 To shpCount)