Comparto con vosotros otra necesidad surgida de un curso de Visual Basic for Applications que recientemente impartí.
Los alumnos se enfrentaban al siguiente problema:
Reciben de datos externos, una hoja Excel, en una de cuyas columnas vienen direcciones de correo electrónico (una diferente para cada fila), pero cuyas celdas tienen formato de texto.
El proceso que seguían para convertir esas celdas con formato texto a celdas hipervinculadas era totalmente manual.
Enfrentamos la tarea con una combinación de código propio y macros generadas por el Grabador de Macros de Excel, ajustando éstas últimas a nuestra solución.
El código resultante quedó como sigue:
‘ Procedimiento para probar <ConvetrtirTextoToHipervinculo>.
‘ Solo a fines de prueba.
Sub InvocarConvertirTextoToHipervinculo()
Call ConvertirTextoToHipervinculo(«Hoja1»,1)
End Sub
‘ Procedimiento para probar <QuitarHipervinculos>.
‘ Solo a fines de prueba.
Sub InvocarQuitarHipervinculos()
Dim oHoja As Excel.Worksheet
Dim oRango As Excel.Range
Dim lngUltimaFilaRango As Long
Set oHoja = ThisWorkbook.Worksheets(«Hoja1»)
lngUltimaFilaRango = oHoja.Cells(Rows.Count, «A»).End(xlUp).Row
Set oRango = oHoja.Range(«A1:A» & lngUltimaFilaRango)
Call QuitarHipervinculos(oRango)
ThisWorkbook.Worksheets(«Hoja1»).Cells(1, 1).Select
End Sub
‘ ====================================================================
Sub ConvertirTextoToHipervinculo(ByVal pNombreHoja As String, _
ByVal pNumeroColumnaHipervinculo As Integer)
Dim oHoja As Excel.Worksheet
Dim lngUltimaFilaRango As Long
Dim sLetraColumnaHipervinculo As String
Dim i As Long
Set oHoja = ThisWorkbook.Worksheets(pNombreHoja)
sLetraColumnaHipervinculo = _
ConvertirNumeroColumaToLetraColumna(pNumeroColumnaHipervinculo)
lngUltimaFilaRango = oHoja.Cells(Rows.Count, _
sLetraColumnaHipervinculo).End(xlUp).Row
For i = 2 To lngUltimaFilaRango
oHoja.Hyperlinks.Add Anchor:= _
oHoja.Cells(i, pNumeroColumnaHipervinculo), _
Address:= _
«mailto:» & CStr(oHoja.Cells(i, pNumeroColumnaHipervinculo).Value), _
TextToDisplay:= _
oHoja.Cells(i, pNumeroColumnaHipervinculo).Value
Next i
End Sub
Sub QuitarHipervinculos(ByVal pRango As Excel.Range)
pRango.Hyperlinks.Delete
End Sub
Function ConvertirNumeroColumaToLetraColumna(ByVal pNumeroColumna As
Integer) As String
Dim sLetraColumna As String
sLetraColumna = Cells(1, pNumeroColumna).Address(True, False)
sLetraColumna = Replace(sLetraColumna, «$1», «»)
ConvertirNumeroColumaToLetraColumna = sLetraColumna
End Function