Estoy intentando escribir código VBA para validar enlaces en una hoja de cálculo. Lo hice funcionar bien hasta que encontré hipervínculos creados a partir de una fórmula. Por ejemplo =Hyperlink(A1,"Link1")o=Hyperlink(A1&A2,"Link2")
El VBA estándar Hyperlinks(1).Addressno los registra como si tuvieran un enlace y no puedo encontrar otras soluciones en línea.
¿Algunas ideas?
Respuesta1
Aquí hay un enfoque simple que manejaráalgunode tus fórmulas. DecirA1contiene la fórmula:
=HYPERLINK("http://www.google.com","search")
Si lo seleccionamos y ejecutamos:
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
obtenemos:
El código descarta el principio y el final de la fórmula y devuelve la URL.
El problema surge si el primer argumento de la función es unexpresiónpreferible aconstante de cadena.
Entonces necesitarías EVALUATE()esa expresión.
Respuesta2
Para el caso más general, simplemente puedes usar algo como:
url_formula = Split(Mid(cell.formula, 12), ",")(0)
Debug.Print Evaluate(url_formula)
Donde Mid(cell.formula, 12)elimina la =HYPERLINK(parte de la fórmula y Split(..., ",")(0)divide el resto de la fórmula en la parte de la coma ( (0)selecciona la primera parte de la división y, por lo tanto, tiene base cero a diferencia de la mayoría de la indexación en Excel).
Luego, use la Evaluatefunción para evaluar la expresión resultante. Esto debería ser bastante general, al menos tan general como Evaluatelo permita la función.
Respuesta3
Otras respuestas no manejan muy bien las variaciones en la fórmula. Por ejemplo, fallan si la fórmula contiene tanto el parámetro LINK_LOCATION como el parámetro FRIENDLY_NAME. Otros también fallan si la fórmula tiene espacios adicionales o saltos de línea en determinadas áreas.
Esta respuesta no es perfecta, pero funciona mejor que otras respuestas que he encontrado en la fecha en que publico esto. He identificado casos en los que este código funcionará y en los que fallará.
Esta función de VBA es un poco larga pero extraerá la URL/dirección de un hipervínculo ya sea de una fórmula HYPERLINK() o de un hipervínculo sin fórmula incrustado en una celda.
Primero busca un hipervínculo que no sea de fórmula, ya que es el hipervínculo extraído más fácil y confiable. Si no existe ninguno, busca un hipervínculo en una fórmula.
La extracción de una fórmula SÓLO funciona si no hay nada fuera de la función HYPERLINK() excepto un signo igual.
Fórmulas HYPERLINK() aceptables
ÉlVOLUNTADtrabajar en esta fórmula:
=HYPERLINK("https://" & A1, "My Company Website")
ÉlVOLUNTADtrabaje también en esta fórmula (observe los espacios adicionales y los saltos de línea):
=
HYPERLINK( "https://" & A1,
"My Company Website" & B2)
Va aNOtrabajar en esta fórmula:
=IF( LEN(A1)=0, "", HYPERLINK("https://" & A1, "My Company Website") )
Función
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
Cómo utilizar la función
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