AYUDA CON MACRO

05/08/2006 - 23:23 por Sandra | Informe spam
Hola, quería crear una macro que revisara todos los hipervinculos de una hoja
de excel y cuando encontrara uno con una ruta determinada, la renombrara o
sustituyera por otra. Un amigo me paso la que reproduzco más abajo, pero no
funciona. Si alguien pudiera decirme donde falla y que tengo que hacer para
que funcione, se lo agradecería. La macro es la siguiente:

Sub HyperLinkChange()
Dim oldtext As String
Dim newtext As String
Dim h As Hyperlink

' These can be any text portion of a hyperlink.
oldtext = "C:\Documents and Settings\user\Datos de
programa\Microsoft\Excel\"
newtext = "\\server\CarpetaComun\Comercial\Compras\"

' Check all hyperlinks on active sheet.
For Each h In ActiveSheet.Hyperlinks
x = InStr(1, h.Address, oldtext)
If x > 0 Then
If h.TextToDisplay = h.Address Then
h.TextToDisplay = newtext
End If
h.Address = Application.WorksheetFunction. _
Substitute(h.Address, oldtext, newtext)
End If
Next
End Sub
 

Leer las respuestas

#1 KL
06/08/2006 - 00:09 | Informe spam
Hola Sandra,

Como no dices en que exactamente se manifiesta el "no funciona" tal vez la causa sea el corte de la siguiente linea del codigo:

oldtext = "C:\Documents and Settings\user\Datos de
programa\Microsoft\Excel\"

Y si no, prueba el siguiente codigo:

Sub HyperLinkChange()
Dim oldtext As String
Dim newtext As String
Dim h As Hyperlink
oldtext = _
"C:\Documents and Settings\user\Datos de programa\Microsoft\Excel\"
newtext = _
"\\server\CarpetaComun\Comercial\Compras\"
For Each h In ActiveSheet.Hyperlinks
With h
.TextToDisplay = Replace(.TextToDisplay, oldtext, newtext)
.Address = Replace(.Address, oldtext, newtext)
End With
Next h
End Sub

Saludos,
KL


"Sandra" wrote in message news:
Hola, quería crear una macro que revisara todos los hipervinculos de una hoja
de excel y cuando encontrara uno con una ruta determinada, la renombrara o
sustituyera por otra. Un amigo me paso la que reproduzco más abajo, pero no
funciona. Si alguien pudiera decirme donde falla y que tengo que hacer para
que funcione, se lo agradecería. La macro es la siguiente:

Sub HyperLinkChange()
Dim oldtext As String
Dim newtext As String
Dim h As Hyperlink

' These can be any text portion of a hyperlink.
oldtext = "C:\Documents and Settings\user\Datos de
programa\Microsoft\Excel\"
newtext = "\\server\CarpetaComun\Comercial\Compras\"

' Check all hyperlinks on active sheet.
For Each h In ActiveSheet.Hyperlinks
x = InStr(1, h.Address, oldtext)
If x > 0 Then
If h.TextToDisplay = h.Address Then
h.TextToDisplay = newtext
End If
h.Address = Application.WorksheetFunction. _
Substitute(h.Address, oldtext, newtext)
End If
Next
End Sub

Preguntas similares