¿Cómo se prueba que un Rango en Excel tiene celdas?

Question

He encontrado un problema en Excel/VBA en el evento Worksheet_Change. Necesito asignar Target.Dependents a un rango, pero si no tiene dependientes, aparece un error. Intenté probar Target.Dependents.Cells.Count, pero eso no funcionó. ¿Algunas ideas?

Private Sub Worksheet_Change(ByVal Target As Range) 

If Target.Cells.Count > 1 OR Target.Dependents.Cells.Count = 0 Then Exit Sub 

Dim TestRange As Range 

Set TestRange = Target.Dependents 

También he intentado "Target.Dependents Is Nothing".

Answer 1

Respuesta corta, no hay forma de probar los dependientes sin generar un error, ya que la propiedad en sí está configurada para generar un error si se accede y no hay ninguno. No me gusta el diseño, pero no hay forma de prevenirlo sin suprimir los errores. AFAIK, esto es lo mejor que vas a poder hacer con él.

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 

Explicación, si no hay dependientes se produce un error y el valor de HasDependents se mantiene sin cambios desde el valor predeterminado tipo, que es falso, de este modo se devuelve false. Si hay dependientes en, el valor del recuento nunca será cero. Todos los enteros distintos de cero se convierten en verdadero, por lo que cuando se asigna el recuento como el valor de retorno, se devuelve verdadero. Es bastante parecido a lo que ya estás usando.

Answer 2

Aquí es la única manera que encontré para hacer que funcione, pero me encantaría una solución mejor:

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

If TestRange.HasFormula And Err.Number = 0 Then ... 

Answer 3

Como se encuentra en: 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