jueves, 18 de abril de 2024

78 - Crear hojas a partir de una Plantilla, para lista de destinatarios.

 Si tenemos nuestra documentación en forma de base de datos (facturación, cobranzas, documentos emitidos, etc), en algún momento necesitaremos enviar esa documentación a los destinatarios. O necesitaremos guardar en hojas separadas esa información.

En este ejemplo, parto de una lista de facturas emitidas y la idea es guardar esa información en formato de documento, por cada cliente de la lista.

Ejemplo 1: la lista no se encuentra filtrada. Se controla si el registro tiene saldo a facturar.




Sub facturando()

Dim hoC As Worksheet, hoF As Worksheet

 

'se declaran las 2 hojas del proceso

Set hoC = Sheets("Clientes")

Set hoF = Sheets("Formato")

 

'recorrer el rango a facturar

With hoC

    For i = 4 To Range("B" & Rows.Count).End(xlUp).Row

        'comprobar si tiene saldo <> 0

        If .Range("X" & i) = 0 Then GoTo sigueOtro

       

        'crear copia de la hoja Formato agregándola al final

        hoF.Copy After:=Sheets(Sheets.Count)

        On Error Resume Next

        ActiveSheet.Name = .Range("D" & i).Text

        If Err.Number > 0 Then GoTo existeHoja

sigo:

        On Error GoTo 0

        Set hoX = ActiveSheet

        'pasar los datos a la nueva hoja

        hoX.[D2] = .Range("D" & i)      'nbre clie

        hoX.[D3] = .Range("C" & i)      'cod clie

        hoX.[D4] = .Range("E" & i)      'domicilio clie

        hoX.[B6] = .Range("F" & i)      'nro fact

        hoX.[E6] = .Range("B" & i)      'fecha

       

        'evluar si hay valores en H o en I

        If .Range("H" & i) = 0 Then

            hoX.[E15] = .Range("I" & i)

        Else

            hoX.[E15] = .Range("H" & i)

        End If

       

        'concatenar col AA + AB

        hoX.[A10] = .Range("AA" & i) & " " & .Range("AB" & i)

       

        hoX.[E16] = .Range("M" & i)    'iva

        hoX.[E17] = .Range("W" & i)     'retencion

'se pasa a la fila siguiente de la hoja base

sigueOtro:

    Next i

   

End With

 

MsgBox "Fin del proceso.", , "Información"

Exit Sub

 

existeHoja:

MsgBox "Ya existe una hoja de nombre " & hoC.Range("D" & i).Text & Chr(10) & _

"El formato se guardará con nombre de hoja " & ActiveSheet.Name & ".", vbCritical

GoTo sigo

End Sub



Ejemplo 2: Se aplicará filtro a la lista. Se recorre el rango rellenando el formato solo con datos de filas filtradas. Se controla si el registro tiene saldo a facturar.

Sub facturando_Filtrado()

 

'se declaran las 2 hojas del proceso

Set hoC = Sheets("Clientes")

Set hoF = Sheets("Formato")

 

'controles previos a la salida del formato (si se aplicó filtro => si hay filas filtradas)

x = hoC.Range("B" & Rows.Count).End(xlUp).Row

If x < 4 Then

    MsgBox "No hay datos para facturar.", , "Atención"

    Exit Sub

End If

 

'recorrer el rango a facturar

With hoC

    For Each celdita In .Range("B4:B" & x).SpecialCells(xlCellTypeVisible)

        'fila de la celda visible

        i = celdita.Row

        'comprobar si tiene saldo <> 0

        If .Range("X" & i) = 0 Then GoTo sigueOtro   

        'crear copia de la hoja Formato agregándola al final

        hoF.Copy After:=Sheets(Sheets.Count)

        On Error Resume Next

        ActiveSheet.Name = .Range("D" & i).Text

        If Err.Number > 0 Then GoTo existeHoja

sigo:

        On Error GoTo 0

        Set hoX = ActiveSheet

        'pasar los datos a la nueva hoja

        hoX.[D2] = .Range("D" & i)

        hoX.[D3] = .Range("C" & i)

        hoX.[D4] = .Range("E" & i)

        hoX.[B6] = .Range("F" & i)

        hoX.[E6] = .Range("B" & i)

        If .Range("E" & i) = 0 Then

            hoX.[E15] = .Range("H" & i)

        Else

            hoX.[E15] = .Range("I" & i)

        End If

        hoX.[A10] = .Range("AA" & i) & " " & .Range("AB" & i)

        hoX.[E15] = .Range("B" & i)

        hoX.[E16] = .Range("M" & i)

        hoX.[E17] = .Range("W" & i)   

sigueOtro:

Next celdita

End With

 

MsgBox "Fin del proceso.", , "Información"

Exit Sub

 

existeHoja:

MsgBox "Ya existe una hoja de nombre " & hoC.Range("D" & i).Text & Chr(10) & _

"El formato se guardará con nombre de hoja " & ActiveSheet.Name & ".", vbCritical

GoTo sigo

End Sub


Descargar libro con las macros desde aquí o solicitarlo al correo Gmail de: cibersoft.arg

Ver video Nº 78 desde aquí.

miércoles, 10 de abril de 2024

77 - Graficando sin Gráficos.

 Si tenemos que presentar Informes de planillas con gran cantidad de filas y columnas, podemos hacer uso de un par de herramientas para graficar resultados, sin necesidad de crear Gráficos.

Modelo Nº 1:

a- En el primer grupo de Totales aplicamos Gráfico de barras.  

    Desde menú Inicio, Formato Condicional, Barra de datos, y seleccionamos un estilo a gusto.


b- En el segundo grupo, desde el mismo menú Inicio, Formato condicional, aplicamos Escalas de color, simulando un semáforo.

Nota: En la primera imagen se superpuso una Escala de color sobre un gráfico de Barras.


Modelo Nº 2:


Aquí se intenta graficar la evolución de los resultados mensuales. Para ello, desde menú Insertar optamos por el grupo Minigráficos seleccionando un estilo. En el primer grupo de valores se optó por Columnas y en el segundo por Líneas.


Se puede llamar a esta herramienta con algún rango ya seleccionado. Por ejemplo, si seleccionamos el rango de celdas donde se va a ubicar el gráfico, se nos pedirá el ingreso del rango de Datos.

Nota: una vez insertado el Minigráfico, se activará una nueva barra de herramientas que nos permitirá darle formato a gusto: color de las barras o líneas, marcar el punto más alto y el más bajo y otras opciones más. En el ejemplo, además, se le dió color de fondo a las celdas y se colocó como título las iniciales de los meses para una mejor visualización.


Modelo Nº 3:

En este modelo, el objetivo es colocar un objeto junto a los valores máximo, mínimo y coincidente con el contenido de una celda.

Para ello primero insertaremos unos objetos gráficos como imágenes o iconos (en versión Excel 365). Y luego ejecutaremos una macro para ubicar esos objetos en el Informe.

Nota: para insertar Iconos en versiones Excel 365 los invito a buscar en este Blog, la entrada de Mayo 2023


En el Editor de macros, insertamos un módulo y allí colocaremos la macro que recorrerá esta tabla colocando los objetos en el lugar que les corresponda según los valores de la tabla.

Nota: En el video Nº 77 (Graficando sin Gráficos) de mi canal, alrededor del minuto 5:50 se explica cómo obtener los nombres de los objetos para ser utilizados desde la programación.

Sub graficando_tabla()

Dim maxi As Single, mini As Single, ideal As Single

Dim cd As Range

Dim rangoTabla

 

'guardar los valores máximos y mínimos del rango

rangoTabla = Range("Préstamo[[Saldo final]]").Address

maxi = Application.WorksheetFunction.Max(Range(rangoTabla))

mini = Application.WorksheetFunction.Min(Range(rangoTabla))

ideal = [K1]      'celda donde se encuentra el valor 'ideal'

 

'se recorre el rango buscando el valor maxi y mini

For Each cd In Range(rangoTabla)

 

    'si la celda contiene el valor 'maxi' se coloca el gráfico 4 en el tope y margen izquierdo de esa celda

    If cd.Value = maxi Then

        ActiveSheet.Shapes.Range(Array("Gráfico 4")).Top = cd.Top

        ActiveSheet.Shapes.Range(Array("Gráfico 4")).Left = cd.Offset(0, 1).Left + 20

       

    ElseIf cd.Value = mini Then

        'si la celda contiene el valor 'mini' se coloca el gráfico 2 en el tope y margen izquierdo de esa celda

         ActiveSheet.Shapes.Range(Array("Gráfico 2")).Top = cd.Top

         ActiveSheet.Shapes.Range(Array("Gráfico 2")).Left = cd.Offset(0, 1).Left + 20

 

    ElseIf cd.Value = ideal Then

        'si la celda contiene el valor 'mini' se coloca la imagen en el tope y margen izquierdo de esa celda

         ActiveSheet.Shapes.Range(Array("Group 17")).Top = cd.Top

         ActiveSheet.Shapes.Range(Array("Group 17")).Left = cd.Offset(0, 1).Left + 20

    End If

Next cd

End Sub

 


Nota: En el libro que se puede descargar desde este enlace o solicitarlo al correo Gmail: cibersoft.arg encontrarán otra macro que recorre un rango común (no Tabla).

Ver video Nº 77 desde aquí.


domingo, 24 de marzo de 2024

76 - Diferencias entre Notas y Comentarios. Cómo agregarlos mediante VBA.

En entradas anteriores (Nov.2018 y Abr.2019) vimos diferentes modelos de Comentarios. Cómo formatearlos (formas, colores e imágenes) y además cómo programar en VBA el agregado o modificación de estos objetos. 

Estos temas fueron mostrados en mi canal Soluciones Excel, en los siguientes videos:

Nº 17: Agregar COMENTARIOS en hoja Excel   (no apto para versiones Excel 365)

Nº 24: Comentarios en Excel mediante programación VBA    (no apto para versiones Excel 365)

Ahora, con la llegada de la versión Excel 365, los antiguos 'comentarios' pasaron a llamarse 'Notas'. Estos objetos Notas todavía conservan la posibilidad de cambios en sus formatos (colores, formas e imagen). Y en VBA siguen llamándose Comment.

Los nuevos Comentarios en cambiono permiten el cambio de formato. Pero sí permiten el agregado de respuestas en dicho cuadro.

En esta nueva versión 365, al seleccionar una celda con comentario, se abrirá un panel lateral a la derecha mostrando el texto original y la posibilidad de agregar una respuesta que se publicará al presionar el botón verde. Y así se irán viendo los autores, fecha y texto de las diferentes respuestas.


Y en VBA, el término 'Comment' pasa ahora a llamarse CommentThreaded.

Veamos un ejemplo de cómo agregar comentarios y respuestas en VBA, ya sea en las versiones clásicas de Excel y en versión 365:

A continuación evaluaremos el cambio en las celdas de dos columnas.  

Si se trata de la columna C agregaremos una NOTA. Si la celda ya presenta una NOTA se sobrescribirá. Y si se borra la celda, también se borrará la NOTA.

En cambio si se trata de la columna I agregaremos COMENTARIOS. Si se borra la celda, se mostrará el cambio como un nuevo comentario.

 Private Sub Worksheet_Change(ByVal Target As Range)

'no se evalúan los cambios en fila 1 ni tampoco si se han seleccionado varias celdas

If Target.Count > 1 Or Target.Row = 1 Then Exit Sub


'si el cambio se da en col 3 (C) se deja solo una NOTA

If Target.Column = 3 Then


    Target.ClearComments    'otra opción: evaluar si hay una nota o no.

    Target.AddComment "Compartir este evento con Jose Luis."


    

'si el cambio se da en col I de la tabla de costos se agrega como Comentarios el nombre del usuario y el importe ingresado. 

ElseIf Target.Column = 9 Then


    'evaluar si la celda no tiene aún comentario, o sea es el primero a registrar

    If Target.CommentThreaded Is Nothing Then

        Target.AddCommentThreaded Application.UserName & "_" & Target.Value

    Else

        'si ya tiene algún comentario se agrega una 'respuesta'

        Target.CommentThreaded.AddReply Application.UserName & "_" & Target.Value

    End If

End If

End Sub



NOTA: Si utilizamos el mismo libro en diferentes versiones, los comentarios creados en versión Excel clásico se verán en Excel 365 tal como fueron creados, solo que ahora estarán en el menú 'Notas'.
En cambio los nuevos comentarios creados desde Excel 365, al pasarlos a la versión Excel clásico se verán como los de siempre (con formato) y con un aviso de parte de Microsoft, donde se informa de que los cambios realizados aquí ya no se verán como 'Respuestas' en la versión 365.



Ver video N° 76 desde aquí.


martes, 12 de marzo de 2024

75 - Ejecutar macros dinámicamente

 Las macros en Excel pueden ejecutarse de varias maneras:

- al clic de un botón ActiveX, un botón de la barra Formulario o algún control dentro de un Userform.

- al clic en algún objeto incrustado en la hoja.

- con la instrucción Call nombre_de_macro . De esta manera las llamamos desde cualquier otro proceso. Por ejemplo: al abrir un Userform deseamos primeramente ordenar una lista para rellenar algún control ComboBox o ListBox, tendremos una instrucción del tipo: Call ordena_Clientes

- desde algún evento de Libro o de Hojas.

- de modo dinámico. Es decir, que sin invocar su nombre, podremos llamar a la macro por el contenido de alguna celda o selección dentro de un desplegable.

Las macros ya estarán ubicadas en un módulo. El nombre de cada macro tendrá que coincidir con el contenido de las celdas o con los elementos de una lista desplegable si fuera el caso.

Ejemplo Nº 1:  al doble clic en celdas de meses o conceptos de Caja, se llamará a la macro según el contenido de la celda: En la hoja de Caja, se colocará el siguiente código:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'controla posible error al seleccionar una celda sin macro asociada.

On Error Resume Next                

'ejecuta la macro cuyo nombre coincida con el contenido de la celda activa 

Application.Run (Target.Value) 

'coloca el foco en otra celda. Aquí, 1 fila hacia abajo en la misma columna. 

Target.Offset(1, 0).Select

 

End Sub

                    


 

Ejemplo Nº 2:  al seleccionar algún elemento del desplegable, se ejecutará la macro cuyo nombre coincida con el elemento seleccionado. El código ubicado en el Userform será:

Private Sub ComboBox2_Click()
On Error Resume Next
Application.Run (ComboBox2.Text)
End Sub


                
            En uno o varios módulos tendremos las macros:

Sub INGRESOS()

MsgBox "Estoy ejecutanto la macro de INGRESOS!"

End Sub 

Sub EGRESOS()

MsgBox "Estoy ejecutanto la macro de EGRESOS!"

End Sub


Sub ENERO()

MsgBox "Estoy ejecutanto la macro de ENERO!"

End Sub

Sub FEBRERO()

MsgBox "Estoy ejecutanto la macro de FEBRERO!"

End Sub


Sub TALLER_CORTE()

MsgBox "Estoy ejecutanto la macro de TALLER_CORTE!"

End Sub

Sub TALLER_COSTURA()

MsgBox "Estoy ejecutanto la macro de TALLER_COSTURA!"

End Sub

NOTA: En caso de tener otras hojas donde los nombres, por ejemplo de Meses, aparecen en minúscula se antepondrá la función UCASE al valor de la celda.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim nbreHoja As String

If Target.Column = 3 And Target.Row > 2 Then

    nbreHoja = UCase(Target.Value)      'convertir texto en mayúsculas

    Application.Run (nbreHoja)

    Target.Offset(1, 0).Select

End If

End Sub

 


 

                    Ver video Nº 75 desde aquí.


jueves, 13 de julio de 2023

74 - TEXTBOX (Parte 2) - Realizar cálculos y asignar formatos a otro tipo de controles.

 En el tema anterior aprendimos a controlar el tipo de caracteres que ingresamos en un control TextBox, con el fin de asignarle formatos moneda, números con decimales, y formatos especiales.

En este tema, veremos cómo realizar cálculos a medida que rellenamos una cierta cantidad de TextBox. Programaremos los eventos KEYPRESS y EXIT, guardando el acumulado en otro tipo de control, en este caso un LABEL.

También veremos cómo 'descontar' el valor que tiene un control a la hora de modificar su contenido. Y que esos cambios se reflejen en el total acumulado. Para esto trabajaremos con el evento ENTER de los TextBox.

En este ejemplo tenemos un formulario (Userform2) con 3 controles TextBox y un control Label donde guardaremos el acumulado.


En este ejemplo, incompleto, cada uno de los controles tendrá programados 2 eventos: 

- KEYPRESS para controlar que solo se ingresen valores numéricos, coma decimal y signo menos. También se puede optar por permitir el punto en caso de que ese sea el separador de decimales.

Desde Google encontramos gran cantidad de páginas que nos ofrecen la lista completa de caracteres Ascii necesarios para evaluar los caracteres que vamos tipeando en cada TextBox.

-EXIT para acumular el contenido de este control a un total que se va mostrando en un Label. Y a ese total, como así también al control de texto, se le asigna un formato moneda.

Por lo tanto cada control tendrá las siguientes 2 subrutinas, ajustando en cada grupo el nombre del TextBox.

Previamente declaramos una variable para ir guardando el acumulado.

Dim importe As Double     'guarda el acumulado como decimal.

 

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If (KeyAscii < 48 And KeyAscii <> 44 And KeyAscii <> 45) Or KeyAscii > 57 Then

    KeyAscii = 0

    MsgBox "Solo ingresa números, signo menos y coma decimal"

End If

End Sub


Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    If TextBox1 <> "" Then importe = importe + CDbl(TextBox1.Value)

    Label2.Caption = Format(importe, "$ #,###,##0.00")

    TextBox1 = Format(TextBox1.Value, "$ #,###,##0.00")

End Sub

NOTA: para que se reconozca como un valor doble, es decir decimal, debemos convertir el contenido del TextBox con la función CDBL.

Pero este ejemplo no nos dará resultados correctos en caso de que modifiquemos alguna cifra, porque estaría sumando nuevamente el valor del control al momento de salir de él.

Por lo tanto necesitamos controlar, además, el evento ENTER. Allí guardaremos en una nueva variable el contenido del TextBox al momento de ingresar a él. Y al salir, en el evento Exit restaremos ese valor y acumularemos el nuevo importe.

Dim valorx As Double

 

Private Sub TextBox1_Enter()   'al ingresar al control se guarda el contenido para luego descontarlo

If TextBox1 <> "" Then valorx = CDbl(TextBox1.Value)

End Sub

Ahora sí ya tendremos todo el código necesario: las 2 variables 'double' y los 3 eventos para cada uno de los TextBox.

Como al salir de cada TextBox debemos realizar varias tareas, y serán las mismas para cada control, podemos agruparlas en una subrutina auxiliar. A esa subrutina solo necesitaremos pasarle como argumento el nombre del TextBox utilizado.

Por lo tanto vamos a reemplazar el evento Exit anterior por este otro. Y será igual en todos los controles.

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)  'al salir se acumula y se aplica formato

    Call calcular("TextBox1")

End Sub


Solo nos resta agregar la subrutina llamada 'calcular', en el mismo Userform.

Sub calcular(miCtrl)

'evaluamos entre todos los controles del Userform, el que se llame como el argumento miCtrl.

If Me.Controls(miCtrl).Value <> "" Then

   'si el textbox tiene un importe se acumula al total y se resta el valor que tenía al momento de ingresar en él

  importe = importe + CDbl(Me.Controls(miCtrl).Value) - valorx

Else

  'si el textbox quedó vacío solo se resta el valor que tenía al momento de entrar en él.

  importe = importe - valorx

End If

'se coloca el acumulado en el Label y se asigna formato moneda

Label2.Caption = Format(importe, "$ #,###,##0.00")

'también se coloca formato al textbox que llamó a esta subrutina.

Me.Controls(miCtrl) = Format(Me.Controls(miCtrl), "$ #,###,##0.00")

'se limpia la variable auxiliar

valorx = 0

End Sub



Ver video Nº 74 desde aquí.


El libro con los ejemplos presentados en videos 73 y 74 se puede descargar desde este enlace. O solicitarlo a mi correo: cibersoft.arg@gmail.com







jueves, 29 de junio de 2023

73 - TEXTBOX : Con formatos y control de contenidos.

Considerando que los controles TEXTBOX son controles de 'textos', para trabajarlos con valores numéricos tendremos que controlar su ingreso y además luego darle un formato apto para utilizarlos en cálculos numéricos.

Los principales eventos que utilizaremos en este primer ejemplo son: 

- KEYPRESS : nos permite controlar cada caracter (KeyAscii) introducido.  

- EXIT : nos permite asignar un formato al salir del control, y también controlar contenidos o aplicar  restricciones.

En el Userform1 tenemos 3 controles TextBox. 

                                  

En el primer control, TextBox1, no hay restricciones. Se reciben números, letras y caracteres alfanuméricos. Solo se indica que en caso de ser un contenido numérico, le aplique formato moneda corriente (ver NOTAS al pie).

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)  

'al salir se aplica formato

   If VBA.IsNumeric(TextBox1.Value) And TextBox1 <> "" Then

       TextBox1 = Format(TextBox1.Value, "$ #,###,##0.00")

   End If

End Sub

En el segundo control, TextBox2, solo se permiten números, coma decimal y signo -

Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

   If (KeyAscii < 48 And KeyAscii <> 44 And KeyAscii <> 45) Or KeyAscii > 57 Then

       KeyAscii = 0

       MsgBox "Solo ingresa números, signo menos y coma decimal"

   End If

End Sub


En este evento, el cursor permanecerá en el control TextBox2 hasta ingresar los valores correctos.

Y al salir del objeto, se aplicará formato moneda:

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    TextBox2 = Format(TextBox2.Value, "$ #,###,##0.00")

End Sub


En el tercer objeto, TextBox3, solo se permiten números. 

Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

   If (KeyAscii < 48 Or KeyAscii > 57) Then

       KeyAscii = 0

       MsgBox "Solo ingresa números."

   End If

End Sub

La restricción que le aplicamos a este control, y que se evalúa en el evento EXIT, es decir al momento de salir de él, es que tenga un máximo de 6 caracteres. Y se le aplica un formato especial del tipo 000-000.

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    If Len(TextBox3) > 6 Then

        MsgBox "Máximo 6 dígitos"

        Cancel = True

    Else

        TextBox3 = Format(TextBox3.Value, "000-000")

    End If

End Sub



NOTAS: 

La función LEN nos devuelve el total de caracteres que presenta el control TextBox.

La instrucción Cancel = True hará que el cursor permanezca en el control hasta cumplir con la condición de los 6 caracteres.  Esto no sucede si utilizamos el evento AfterUpdate.

El formato 'moneda' puede ser indicado también de este modo, para que se tome la moneda corriente del usuario.

    TextBox2 = Format(TextBox2.Value, "Currency")


Descargar ejemplo del Userform1 desde aquí o solicitarlo al correo:  cibersoft.arg@gmail.com

Ver video Nº 73 desde aquí.





martes, 18 de abril de 2023

72 - Modificar hipervínculos masivamente.

 Cuando tenemos en un libro Excel vínculos hacia otras hojas u otras referencias de fila/columna, nos encontramos con el problema de que al moverlos siguen conectados al origen. 

Así, por ejemplo, si tenemos una hoja como en la siguiente imagen, donde cada vínculo nos lleva a un cuadro dentro de la Hoja1, al copiar esa hoja y asignarle otro nombre el vínculo siempre nos dirige a la hoja de origen, o sea a la Hoja1.

Para resolver esta situación, utilizaremos una macro de pocas instrucciones, donde vamos a cambiar el argumento SubAddress, o sea la dirección del vínculo. 

Y además, en este ejemplo, modificaremos otros 2 argumentos: 

. ScreenTip (el texto que se muestra al pasar el mousse por encima del vínculo) y 

. TextToDisplay (el texto o valor que se muestra en la celda).


En un módulo copiaremos esta macro:

Sub ModificarHipervinculos()        'modificar los hipervínculos dirigiéndolos a otra hoja

'x Elsamatilde

Dim anterior As String, nuevo As String, nvaDire As String, cadena As String

Dim x As Integer, y As Integer

Application.ScreenUpdating = False

anterior = "Hoja1": nuevo = ActiveSheet.Name     'nombres de hojas

Range("O:O").Clear                              'limpia col auxiliar

y = Range("A" & Rows.Count).End(xlUp).Row    'recorre la col A que tiene los hipervínculos a modificar

For x = 4 To y

    Range("O" & x) = Range("A" & x).Hyperlinks(1).SubAddress        'coloca en col auxiliar el hipervínculo

    Range("O" & x).Replace What:=anterior, Replacement:=nuevo       'reemplaza el texto anterior por el nuevo

    Range("A" & x).Select                                           'vuelve a crear el hipervínculo en la col donde se encontraba

    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", _

    SubAddress:=nvaDire, _

    ScreenTip:=cadena, _

    TextToDisplay:=ActiveCell.Text

Next x

MsgBox "Fin del proceso."

End Sub

Luego se podrá ejecutar desde el menú Programador/Desarrollador estando en la hoja activa, es decir, donde se encuentra la lista de vínculos que deseamos actualizar.

NOTA: podemos incluir el valor de las variables directamente en la instrucción del Hyperlink, quedándonos así:

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", _

    SubAddress:=Range("O" & x), _

    ScreenTip:=ActiveSheet.Name & "-" & Range("A" & x), _

    TextToDisplay:=ActiveCell.Text


El libro de ejemplo se puede descargar desde este enlace o solicitarlo al correo: cibersoft_arg@gmail.com

Ver video Nº 72 con el paso a paso desde aquí.