** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Otros de Microsoft: Windows y Office > Excel
  Mensajes nuevos Mensajes nuevos RSS - Añadir comentarios en macro para cambio hipervinc.
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoAñadir comentarios en macro para cambio hipervinc.

 Responder Responder
Autor
Mensaje
albertosf Ver desplegable
Nuevo
Nuevo


Unido: 16/Julio/2014
Localización: España
Estado: Sin conexión
Puntos: 1
Enlace directo a este mensaje Tema: Añadir comentarios en macro para cambio hipervinc.
    Enviado: 16/Julio/2014 a las 11:11
Antes de nada buenos días a todos, soy nuevo en el foro y venia a ver si me podeis echar un cable que siendo sinceros hace mucho que toque algo de VBA.

La cosa es que dispongo de  una tabla excel con una macro que me han pasado creada, que es supuestamente para cambiar los hipervinvculos que hay en la tabla ya que se van a mover las carpetas de una ruta a otra, en el excel hay una lista bastante grande de hiperviculos a documentos en ciertas rutas.

Esta compuesto de la siguientes columnas:

Columna A            // Columna B                // Columna C                                            //  Columna D    
Nombre del docu. // Una texto asociado  // nombr. del archivo con el hipervinluclo  //  Ruta

Necesitaria comprender la macro que hay creada ya que no hace lo que debería, por lo que no se si podrias ayudarme haciendo los comentarios en cada una de las lineas de ella poniendo que es lo que hace... algunos comentarios ya he incluido, pero en la parte densa, me pierdo

Sub Cambiar_parte_ruta_Hipervinculos()

  Dim ws As Worksheet

  '
  Dim Antes As String, Ahora As String, Hyp As Hyperlink

  'Definicion de variables
  Dim x As Integer
  'Definicion de variables 

  Sheets("tabla").Select

  '
  NumRows = Range("A2", Range("A2").End(xlDown)).Rows.Count
  'Cuenta el numero de celdas que hay.
  Range("A2").Select
  'Selecciona la celda A2

  For x = 1 To NumRows
  'Realiza una accion puesta a contiacion por cada celda contada anteriormente

  Antes = ActiveCell
  'Especificamos que la celda seleccionada (A2) va a ser la celda definida como "antes"
  Ahora = ActiveCell.Offset(0, 1)
  'Especificamos que la celda de la derecha a la seleccionada (A2) va a ser la celda definida como "ahora"

(A PARTIR DE AQUI YA TENGO EL JALEO)


   For Each ws In Worksheets 
        If ws.Name <> "tabla" Then
            For Each Hyp In ws.Hyperlinks
              If InStr(1, Hyp.Address, Antes, 1) Then
                If Val(Application.Version) > 8 Then _
                  If Hyp.TextToDisplay = Hyp.Address Then Hyp.TextToDisplay = Ahora
                Hyp.Address = Application.Substitute(LCase(Hyp.Address), LCase(Antes), Ahora)
              End If
             Next
         End If
    Next ws

    ActiveCell.Offset(1, 0).Select
   Next
End Sub



Un saludo y gracias!


Editado por albertosf - 16/Julio/2014 a las 11:12
Arriba
VIMIPAS Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 06/Enero/2006
Localización: ESPAÑA
Estado: Sin conexión
Puntos: 5308
Enlace directo a este mensaje Enviado: 16/Julio/2014 a las 16:45
Hola buenas tardes albertosf, bienvenido, en tu primer mensaje, a este foro.
 
No sé si te servirá, pero Alberto Irigoyen dejó expuesta una solución para un problema también de hipervínculos en este enlace que te pongo:
 
 
Saludos
Gracias
Arriba
sdgm Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 21/Abril/2005
Localización: Guatemala
Estado: Sin conexión
Puntos: 906
Enlace directo a este mensaje Enviado: 16/Julio/2014 a las 17:00

   For Each ws In Worksheets  
   'Para cada hoja (ws) en tu libro...
        If ws.Name <> "tabla" Then
        'si el nombre de la hoja no es "tabla"...
            For Each Hyp In ws.Hyperlinks
            'Para cada hipervínculo (Hyp) en la hoja...
              If InStr(1, Hyp.Address, Antes, 1) Then
              'Si en la dirección del hipervínculo se encuentra el texto de la variable [Antes]...
                If Val(Application.Version) > 8 Then _
                'Si la versión de Excel es superior a la versión 8...
                  If Hyp.TextToDisplay = Hyp.Address Then Hyp.TextToDisplay = Ahora
                  'Si el texto a desplegar es igual a la dirección del hipervínculo, se actualiza el primero al valor de la variable [Ahora]
                Hyp.Address = Application.Substitute(LCase(Hyp.Address), LCase(Antes), Ahora)
                'Se actualiza la dirección del hipervínculo sustituyendo en su texto [Antes] por el nuevo texto de la variable [Ahora]
              End If
             Next
             'Pasa al próximo hipervínculo
         End If
    Next ws
    'Pasa a la próxima hoja


Cordialmente, David
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable