アレイがクリアされるのはなぜですか？

Question

私は、フォントと色が一致していないかどうかを調べるためにスライドチェッカーを設計しており、配列の各図形の各色を追跡する必要があります。私の問題は、何らかの理由で配列がクリアされるということです。配列が適切に割り当てられていることを確認するフラグを入れました。ループ内を移動すると、配列に1が正しく追加され、そのインデックスの色が更新された後、前方に移動します。何らかの理由でmsgboxのチェックに到達すると、配列には正しい数のインデックスが残っていますが、ループ内の最後のシェイプを除くすべてのシェイプに対して配列は空です。たとえば、1つの図形に5行、もう1つの図形に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)