Как Вы тестируете это, Диапазон в Excel имеет ячейки в нем?

Если вы хотите перехватывать исключения, вам, вероятно, следует вернуться к использованию try / catch / finally. Просто поместите вызовы .Dispose () в блок finally.

5
задан lfrandom 6 August 2013 в 20:28
поделиться

3 ответа

Короткий ответ, нет способа проверить наличие иждивенцев, не вызывая ошибки, так как само свойство настроено так, чтобы вызывать ошибку при обращении, а ее нет. Мне не нравится дизайн, но невозможно предотвратить его, не подавляя ошибки. AFAIK, это лучшее, что вы можете с этим сделать.

Sub Example()
    Dim rng As Excel.Range
    Set rng = Excel.Selection
    If HasDependents(rng) Then
        MsgBox rng.Dependents.Count & " dependancies found."
    Else
        MsgBox "No dependancies found."
    End If
End Sub

Public Function HasDependents(ByVal target As Excel.Range) As Boolean
    On Error Resume Next
    HasDependents = target.Dependents.Count
End Function

Объяснение, если нет зависимых, возникает ошибка и значение HasDependents остается неизменным по сравнению с типом по умолчанию, которое имеет значение false, поэтому возвращается false. Если есть иждивенцев , значение счетчика никогда не будет нулевым. Все ненулевые целые числа преобразуются в истину, поэтому, когда в качестве возвращаемого значения назначается счетчик, возвращается истина. Это довольно близко к тому, что вы уже используете.

10
ответ дан 13 December 2019 в 19:34
поделиться

Я нашел единственный способ заставить его работать, но мне бы хотелось лучшего решения:

On Error Resume Next
Dim TestRange As Range
Set TestRange = Target.Dependents

If TestRange.HasFormula And Err.Number = 0 Then ...
1
ответ дан 13 December 2019 в 19:34
поделиться

Как найдено на: http://www.xtremevbtalk.com/t126236.html

    'Returns a Collection of all Precedents or Dependents found in the Formula of the Cell argument
    'Arguments      : 'rngCell' = the Cell to evaluate
    '               : 'blnPrecedents' = 'TRUE' to list Precedents, 'FALSE' to list Dependents
    'Dependencies   : 'Get_LinksFromFormula' function
    'Limitations    : does not detect dependencies in other Workbooks
    'Written        : 08-Dec-2003 by member Timbo @ visualbasicforum.com
    Function Get_LinksCell(rngCell As Range, blnPrecedents As Boolean) As Collection
    Dim rngTemp As Range
    Dim colLinksExt As Collection, colLinks As New Collection
    Dim lngArrow As Long, lngLink As Long
    Dim lngErrorArrow As Long
    Dim strFormula As String, strAddress As String
    Dim varLink
    On Error GoTo ErrorH

        'check parameters
        Select Case False
            Case rngCell.Cells.Count = 1: GoTo Finish
            Case rngCell.HasFormula: GoTo Finish
        End Select

        Application.ScreenUpdating = False

        With rngCell
            .Parent.ClearArrows

            If blnPrecedents Then
                .ShowPrecedents
            Else: .ShowDependents
            End If

            strFormula = .Formula

            'return a collection object of Links to other Workbooks
            If blnPrecedents Then _
                Set colLinksExt = Get_LinksFromFormula(rngCell)

    LoopArrows_Begin:
            Do 'loop all Precedent/Dependent Arrows on the sheet
                lngArrow = lngArrow + 1
                lngLink = 1

                Do
                    Set rngTemp = .NavigateArrow(blnPrecedents, lngArrow, lngLink)

                    If Not rngTemp Is Nothing Then
                        strAddress = rngTemp.Address(External:=True)
                        colLinks.Add strAddress, strAddress
                    End If

                    lngLink = lngLink + 1
                Loop

            Loop

    LoopArrows_End:
            If blnPrecedents Then
                .ShowPrecedents True
            Else: .ShowDependents True
            End If

        End With

        If blnPrecedents Then 'add the external Link Precedents
            For Each varLink In colLinksExt
                colLinks.Add varLink, varLink
            Next varLink
        End If

    Finish:
    On Error Resume Next
        'oh, one of the arrows points to the host cell as well!
        colLinks.Remove rngCell.Address(External:=True)

        If Not colLinks Is Nothing Then Set Get_LinksCell = colLinks
        Set colLinks = Nothing
        Set colLinksExt = Nothing
        Set rngTemp = Nothing
        Application.ScreenUpdating = True

        Exit Function
    ErrorH:
        'error while calling 'NavigateArrow' method
        If Err.Number = 1004 Then

            'resume after 1st and 2nd error to process both same-sheet
            '   and external Precedents/Dependents
            If Not lngErrorArrow > 2 Then
                lngErrorArrow = lngErrorArrow + 1
                Resume LoopArrows_Begin
            End If
        End If

        'prevent perpetual loop
        If lngErrorArrow > 3 Then Resume Finish
        lngErrorArrow = lngErrorArrow + 1
        Resume LoopArrows_End

    End Function





    'Returns a Collection of Range addresses for every Worksheet Link to another Workbook
    '   used in the formula argument
    'Arguments: 'rngCellWithLinks'  = the Cell Range containing the formula Link
    'Written        : 08-Dec-2003 by member Timbo @ visualbasicforum.com
    Function Get_LinksFromFormula(rngCellWithLinks As Range)
    Dim colReturn As New Collection
    Dim lngStartChr As Long, lngEndChr As Long
    Dim strFormulaTemp As String, strFilenameTemp As String, strAddress As String
    Dim varLink
    On Error GoTo ErrorH

        'check parameters
        Select Case False
            Case rngCellWithLinks.Cells.Count = 1: GoTo Finish
            Case rngCellWithLinks.HasFormula: GoTo Finish
        End Select

        strFormulaTemp = rngCellWithLinks.Formula
        'determine if formula contains references to another Workbook
        lngStartChr = Len(strFormulaTemp)
        strFormulaTemp = Replace(strFormulaTemp, "[", "")
        strFormulaTemp = Replace(strFormulaTemp, "]", "'")
        'lngEndChr = Len(strFormulaTemp)

        If lngStartChr = lngEndChr Then GoTo Finish

        'build a collection object of links to other workbooks
        For Each varLink In rngCellWithLinks.Parent.Parent.LinkSources(xlExcelLinks)
            lngStartChr = InStr(1, strFormulaTemp, varLink)

            If Not lngStartChr = 0 Then
                lngEndChr = 1
                strAddress = Mid(strFormulaTemp, lngStartChr + Len(varLink), lngEndChr)

    On Error Resume Next
                'add characters to the address string until a valid Range address is formed
                Do Until TypeName(Range(strAddress)) = "Range"
                    strAddress = Mid(strFormulaTemp, lngStartChr + Len(varLink), lngEndChr)
                    lngEndChr = lngEndChr + 1
                Loop
                'continue adding to the address string until it no longer qualifies as a Range
                If Not (lngStartChr + Len(varLink) + lngEndChr) > Len(strFormulaTemp) Then
                    Do Until Not IsNumeric(Right(strAddress, 1))
                        strAddress = Mid(strFormulaTemp, lngStartChr + Len(varLink), lngEndChr)
                        lngEndChr = lngEndChr + 1
                    Loop
                    'remove the trailing character
                    strAddress = Left(strAddress, Len(strAddress) - 1)
                End If

    On Error GoTo ErrorH
                strFilenameTemp = rngCellWithLinks.Formula
                'locate append filename to Range address
                lngStartChr = InStr(lngStartChr, strFilenameTemp, "[")
                lngEndChr = InStr(lngStartChr, strFilenameTemp, "]")
                strAddress = Mid(strFilenameTemp, lngStartChr, lngEndChr - lngStartChr + 1) & strAddress

                colReturn.Add strAddress, strAddress
            End If

        Next varLink
        Set Get_LinksFromFormula = colReturn

    Finish:
    On Error Resume Next
        Set colReturn = Nothing
        Exit Function

    ErrorH:
        Resume Finish

    End Function
0
ответ дан 13 December 2019 в 19:34
поделиться
Другие вопросы по тегам:

Похожие вопросы: