VBA将数组传递给函数并返回

Question

我已经开始复习 cpearson 关于传递和返回数组的文章，但我对细节有点迷失了。以下内容无效，并由论文确认。似乎我可以通过遍历数组以将每个元素设置为等于另一个数组中的元素来解决问题。如何使用函数执行此操作？

Sub test()

    Dim Arr() as Variant
    Dim CurrDoc as Word.Document

    ReDim Arr(0 to 39, 0 to 1)

    Arr() = FillArr(CurrDoc, Arr())

End Sub

Function FillArr(CurrentDocument As Word.Document, CurrentArray() As Variant) As Variant

    j = 1

    For Each chk In CurrentDocument.ContentControls

        If chk.Type = 8 Then

            CurrentArray(j, 1) = chk.Title
            CurrentArray(j, 2) = chk.Checked

            j = j + 1

        End If

    Next chk

FillArr() = CurrentArray()

End Function

Answer 1

我个人会以不同的方式处理这个问题。

返回所有“复选框”类型内容控件的标题和“选中”状态的函数的有用性低于仅返回特定类型的所有内容控件的函数的有用性。原因如下：

调用该函数的代码已经知道它想要使用Title 和Checked，因此当它获取ContentControl 实例数组而不是字符串和布尔值的多维数组时不会丢失任何内容。但是当调用代码想要操作复选框时，“字符串和布尔值”方法就达不到要求了。

在这个假设下，我们可以去掉数组的一维，得到一个可以在不同场景中复用的函数。

我们也不需要任何数组传递。只需构建数组并返回它：

Function FindControls(Doc As Word.Document, ControlType As WdContentControlType) As Variant
    Dim cct As Variant, i As Integer

    ' figure out how many matching controls there are and allocate an array
    For Each cct In Doc.ContentControls
        If cct.Type = ControlType Then i = i + 1
    Next cct
    ReDim cctArray(i - 1)

    ' save references to matching controls in array
    i = 0
    For Each cct In Doc.ContentControls
        If cct.Type = ControlType Then
            Set cctArray(i) = cct
            i = i + 1
        End If
    Next cct

    FindControls = cctArray
End Function

现在我们可以很自然地在调用代码中使用它了：

Dim c As Variant

For Each c In FindControls(ActiveDocument, wdContentControlCheckbox)
    Debug.Print c.Title, c.Checked
Next

Answer 2

我不想制作一个与您的完全匹配的 word 文档，但您可以通过函数传递数组。我要用随机字符填充我的。

Sub test()
    Dim arr() As Variant
    ReDim arr(1 To 40, 1 To 2)

    arr() = fillarr(arr())

    Dim i As Long

    For i = 1 To 40
        Debug.Print i, arr(i, 1)
        Debug.Print i & "* 5", arr(i, 2)
    Next i
End Sub

Function fillarr(currentarr() As Variant) As Variant
    Dim j As Long

    For j = 1 To 40
        currentarr(j, 1) = Chr(j + 64)
        currentarr(j, 2) = Chr(j * 5)
    Next j

    fillarr = currentarr
End Function

实际上有一个隐含的by ref，因为在 VBA 中数组总是通过引用传递，所以你实际上并不需要一个函数来执行此操作，尽管你可能应该这样做，因为它更清楚，但你可以在这里看到：

Sub test()
    Dim arr() As Variant
    ReDim arr(1 To 40, 1 To 2)

    fillarr arr() 'no value set

    Dim i As Long

    For i = 1 To 40
        Debug.Print i, arr(i, 1)
        Debug.Print i & "* 5", arr(i, 2)
    Next i
End Sub

Sub fillarr(currentarr() As Variant)
    Dim j As Long

    For j = 1 To 40
        currentarr(j, 1) = Chr(j + 64)
        currentarr(j, 2) = Chr(j * 5)
    Next j

    'Note the lack of return
End Sub