Imprimir página | Cerrar ventana

Añadir comentarios en macro para cambio hipervinc.

Impreso de: Foro de Access y VBA
Categoría: Otros de Microsoft: Windows y Office
Nombre del foro: Excel
Descripción del foro: Foro de Excel y VBA de Excel
URL: http://www.mvp-access.com/foro/forum_posts.asp?TID=79342
Fecha de impresión: 16/Febrero/2020 a las 20:31


Tema: Añadir comentarios en macro para cambio hipervinc.
Publicado por: albertosf
Asunto: Añadir comentarios en macro para cambio hipervinc.
Fecha de publicación: 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!



Respuestas:
Publicado por: VIMIPAS
Fecha de publicación: 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:
 
http://www.mvp-access.com/foro/propiedad-hipervinculo-de-un-campo_topic79322.html" rel="nofollow - http://www.mvp-access.com/foro/propiedad-hipervinculo-de-un-campo_topic79322.html
 
Saludos


-------------
Gracias


Publicado por: sdgm
Fecha de publicación: 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



Imprimir página | Cerrar ventana