excel 2010 Vba, loop por intervalos nomeados, erro em tempo de execução '1004':

Question

Eu estou atribuindo a mesma macro a vários OptionButtons. Eu tento determinar em qual intervalo nomeado o cklicked OButton está localizado. Então eu pego o Cell of the Button e faço loop através de todos os Ranges nomeados em minha planilha para encontrar os Intersecting

Meu código até agora:

Sub OptionField()
Dim r As Range
Dim nm As Name
Set r = ActiveSheet.OptionButtons(Application.Caller).TopLeftCell

For Each nm In ActiveSheet.Names
  If InRange(r, ActiveSheet.Range(nm)) = True Then           
  'Loop with ActiveSheet.Range(nm) seems to cause this issue
   Debug.Print nm.Name
  End If
Next nm
End Sub

Function InRange(Range1 As Range, Range2 As Range) As Boolean
'returns True if Range1 is within Range2
 Dim InterSectRange As Range
 Set InterSectRange = Application.Intersect(Range1, Range2)
 InRange = Not InterSectRange Is Nothing
 Set InterSectRange = Nothing
 End Function

Dentro de pequenas variações no meu código, recebo duas mensagens de erro que apontam para o mesmo erro

Mensagem de erro 1: Erro definido pelo aplicativo ou definido pelo objeto

Mensagem de erro 2: Erro em tempo de execução '1004':  Método Intervalo do objeto '_Global' com falha

Eu encontrei a documentação no msdn, mas eu falhei em 'entender' ou como consertar isso.

link

Então eu sei que o VBA está monopolizando uma referência e eu preciso liberá-la, o que me irrita é que o loop funciona bem por várias iterações (não apenas na primeira vez) e depois falha ...

Editar: ele falha quando um Range nomeado se refere às mesmas células de um anterior. Então isso esclarece a coisa da iteração

Eu tentei modificar o loop para isso, mas não muda nada com a referência ..

For Each nm In ActiveSheet.Names
Dim t As Range
Set t = ActiveSheet.Range(nm) 'it stops working here, when an ranges with same cells are called    
 If InRange(r, t) = True Then      
   Debug.Print nm.Name
  End If
Set t = Nothing
Next nm

Qualquer ajuda com isso seria muito apreciada

Muito obrigado

    

Answer 1

Isso melhora a situação?

Function InRange(Range1 As Range, Range2 As Range) As Boolean
    'returns True if Range1 is within Range2
    Dim InterSectRange As Range

    InRange = False
    If Range1 Is Nothing Then
        MsgBox "Range1 is nothing"
        Exit Function
    End If
    If Range2 Is Nothing Then
        MsgBox "Range2 is nothing"
        Exit Function
    End If

    Set InterSectRange = Intersect(Range1, Range2)
    InRange = Not InterSectRange Is Nothing
    Set InterSectRange = Nothing
 End Function

EDIT # 1

Além disso, no sub OptionField () , os intervalos nomeados são provavelmente especificados em excesso. Mudança:

ActiveSheet.Range(nm)

para simplesmente:

Range(nm)

EDIT # 2

por exemplo

Sub demo2()
    Dim r As Range
    Set r = ActiveSheet.Range("A1")
    MsgBox r.Address
    MsgBox ActiveSheet.r.Address
End Sub

o primeiro MsgBox funciona, mas o segundo falha ........... isso ocorre porque uma vez que r tenha sido totalmente qualificado, ele não precisa de uma planilha para qualificá-lo novamente.