Question

我设计了一个幻灯片检查器来查找不匹配的字体和颜色，并且需要跟踪数组中每个形状的每种颜色。我的问题是由于某种原因，阵列被清除了。我已经放入标志来检查阵列是否正确分配。当它在循环中移动时，它正确地向数组添加1，更新该索引的颜色，然后向前移动。出于某种原因，当它进入msgbox检查时，数组仍然具有正确数量的索引，但除了循环中的最后一个形状之外，每个形状的数组都是空的。例如，一个形状有5行，另一个形状有2.我将获得7次msgbox，但前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 Preserve oshpColour(1 To shpCount)

为什么我的阵列被清除了？

1 个答案: