Convertir celdas de una hoja Excel a Hipervínculos

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

Deja un comentario

Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *