Estou tentando escrever código VBA para validar links em planilha. Funcionou bem até encontrar hiperlinks criados a partir de fórmulas. Por exemplo =Hyperlink(A1,"Link1")ou=Hyperlink(A1&A2,"Link2")
O VBA padrão Hyperlinks(1).Addressnão os registra como tendo link e não consigo encontrar nenhuma outra solução online.
Alguma ideia?
Responder1
Aqui está uma abordagem simples que irá lidar comalgunsde suas fórmulas. DizerA1contém a fórmula:
=HYPERLINK("http://www.google.com","search")
Se o selecionarmos e executarmos:
Sub HyperChecker()
Dim s1 As String, s2 As String, arr
s1 = ActiveCell.Formula
s2 = Mid(s1, 12)
arr = Split(s2, ",")
MsgBox arr(0)
End Sub
Nós temos:
O código descarta o início e o fim da fórmula e retorna a URL.
O problema surge se o primeiro argumento da função for umexpressãoao invés de umconstante de string.
Você precisaria então EVALUATE()dessa expressão.
Responder2
Para o caso mais geral, você pode simplesmente usar algo como:
url_formula = Split(Mid(cell.formula, 12), ",")(0)
Debug.Print Evaluate(url_formula)
Where Mid(cell.formula, 12)elimina a =HYPERLINK(parte da fórmula e Split(..., ",")(0)divide o restante da fórmula na parte da vírgula ( (0)seleciona a primeira parte da divisão - e é, portanto, baseado em zero, ao contrário da maioria da indexação no Excel).
Em seguida, use a Evaluatefunção para avaliar a expressão resultante. Isto deve ser bastante geral, pelo menos tão geral quanto a Evaluatefunção permitir.
Responder3
Outras respostas não lidam muito bem com variações na fórmula. Por exemplo, eles falharão se a fórmula contiver os parâmetros LINK_LOCATION e FRIENDLY_NAME. Outros também falham se a fórmula contiver espaços extras ou quebras de linha em determinadas áreas.
Esta resposta não é perfeita, mas funciona melhor do que outras respostas que encontrei na data em que estou postando isso. Identifiquei casos em que esse código funcionará e onde falhará.
Esta função VBA é um pouco longa, mas extrairá o URL/endereço de um hiperlink de uma fórmula HYPERLINK() ou de um hiperlink sem fórmula incorporado em uma célula.
Ele verifica primeiro um hiperlink sem fórmula, pois é o hiperlink extraído mais fácil e confiável. Se não existir, ele verifica um hiperlink em uma fórmula.
A extração de uma fórmula SÓ funciona se não houver nada fora da função HYPERLINK() exceto um sinal de igual.
Fórmulas HYPERLINK() aceitáveis
IstoVAItrabalhe nesta fórmula:
=HYPERLINK("https://" & A1, "My Company Website")
IstoVAItrabalhe nesta fórmula também (observe espaços extras e quebras de linha):
=
HYPERLINK( "https://" & A1,
"My Company Website" & B2)
Ele vaiNÃOtrabalhe nesta fórmula:
=IF( LEN(A1)=0, "", HYPERLINK("https://" & A1, "My Company Website") )
Função
Function HyperLinkText(ByVal Target As Excel.Range) As String
' If TARGET is multiple cells, only check the first cell.
Dim firstCellInTarget As Excel.Range
Set firstCellInTarget = Target.Cells.Item(1)
Dim returnString As String
' First check if the cell contains a non-formula hyperlink.
If Target.Hyperlinks.Count > 0 Then
' Cell contains a non-formula hyperlink.
returnString = Target.Hyperlinks.Item(1).Address ' extract hyperlink text from the Hyperlinks property of the range
Else
' Cell does -NOT- contain a non-formula hyperlink.
' Check for a formula hyperlink.
Dim targetFormula As String
targetFormula = firstCellInTarget.Formula
Dim firstOpenParenthesisIndex As Long
firstOpenParenthesisIndex = VBA.InStr(1, _
targetFormula, _
"(", _
VbCompareMethod.vbBinaryCompare)
Dim cleanFormulaHyperlinkPrefix As String
cleanFormulaHyperlinkPrefix = Left$(targetFormula, firstOpenParenthesisIndex)
cleanFormulaHyperlinkPrefix = Replace$(Replace$(Replace$(cleanFormulaHyperlinkPrefix, Space$(1), vbNullString), vbCr, vbNewLine), vbLf, vbNullString)
Dim cleanFormulaPart2 As String
cleanFormulaPart2 = Mid$(targetFormula, firstOpenParenthesisIndex + 1)
Dim cleanFormulaCombined As String
cleanFormulaCombined = cleanFormulaHyperlinkPrefix & cleanFormulaPart2
' Get all text inside the HYPERLINK() function.
' This is either a single LINK_LOCATION parameter or both the
' LINK_LOCATION and FRIENDLY_NAME parameters separated by a comma.
'
' Ex. 1 Parameter: "https://" & $A$1
' Ex. 2 Parameters: "https://" & $A$1, "Click Here To Open the Company URL"
'
Const HYPERLINK_FORMULA_PREFIX As String = "=HYPERLINK("
Dim tmpString As String
tmpString = Mid$(cleanFormulaCombined, VBA.Len(HYPERLINK_FORMULA_PREFIX) + 1)
Dim textInsideHyperlinkFunction As String
textInsideHyperlinkFunction = Left$(tmpString, VBA.Len(tmpString) - 1)
' Get the first parameter (LINK_LOCATION) from the text inside the HYPERLINK()
' function by using =EVALUATE(). If text inside the HYPERLINK() function
' contains two parameters, they will be separated by a comma and EVALUATE()
' will return an error. Start with the entire text inside the HYPERLINK()
' function. If EVALUATE() returns an error, remove one character from the end
' of the string being evaluated and try again. Eventually only one parameter
' will be evaluated and EVALUATE() will return a text string.
'
' For example, if the string to be evaluated is:
'
' "https://" & $A$1, "Click Here To Open the Company URL"
'
' and cell A1 contains:
'
' mycompany.com
'
' EVALUATE will return:
'
' https://mycompany.com
'
Dim hyperlinkLinkLocation As String
Dim i As Long
For i = VBA.Len(textInsideHyperlinkFunction) To 1 Step -1 ' with each failure, shrink length of string-to-evaluate by one
If Not VBA.IsError(Excel.Application.Evaluate("=" & Left$(textInsideHyperlinkFunction, i))) Then
hyperlinkLinkLocation = Excel.Application.Evaluate("=" & Left$(textInsideHyperlinkFunction, i))
Exit For ' ****
End If
Next i
returnString = hyperlinkLinkLocation
End If
' Return the hyperlink string.
HyperLinkText = returnString
End Function
Como usar a função
Sub Test()
' Display hyperlink of the first cell
' in the currently selected range.
Msgbox HyperLinkText(Selection) ' displays the hyperlink of the first cell
End Sub