Excel - crear hipervinculo y llamar archivo PDF desde excel con VBA en

   
Vista:

crear hipervinculo y llamar archivo PDF desde excel con VBA en

Publicado por ric (1 intervención) el 23/03/2017 00:23:24
buenas tardes...

requiero de su ayuda si me dan la solucion a una funcion de hipervinculo en excel con VBA
explico lo que requiere que haga:
tengo un archivo de excel en el cual se lleva un control de vales de entradas y salidas en cada celda se describe su concepto, en especifica una celda se anota el consecutivo del vale el cual esta en formato PDF y con nombre mas detallado, requiero que desde esa celda al momento de meter cierta parte del consecutivo del nombre del PDF esta celda con ese criterio se convierta en hipervinculo y que con el clic me abra el archivo del PDF.
en la celda B8 solo anoto parte del nombre del archivo y el archivo en si tiene un nombre mas amplio porngo ejemplo:
celda B8 "vale-007-2017" y el archivo PDF su nombre real es 170101_vale-007-2017 repuesto.pdf

esta es la funcion que hice, si crea el hipervinculo pero solo me llega abrir hasta la carpeta donde se encuentra alojado el archivo de PDF, y requiero que haga tambien el abrir el archivo de PDF, alguien me puede ayudar a decirme si algo hace falta o que haya corregir...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim texto As String
On Error GoTo Err_vinculo
texto = Target.Value


Dim cachar As String

' Dim contador As Integer
'contador = 0

'For contador = 8 To 1048576

'texto = Range("b" & contador)

Dim final As String

If Target.Column = 2 Then
If texto <> "" Then



If IsNull(texto) = False Then
If Left(Range("a" & Target.Row), 7) = "ENTRADA" Then
'If Left(Range("a" & contador), 7) = "ENTRADA" Then

cachar = Dir("\\D:\ALMACEN\VALES\ENTRADA\" + texto + "*.pdf")
final = (Replace(cachar, " ", "%20", , , vbTextCompare))

' Range("b" & contador).Hyperlinks.Add Range("b" & contador), "Entrada\" + final
'Range("b" & Target.Row).Hyperlinks.Delete

Selection.Hyperlinks.Add Target, "ENTRADA\" + final

End If
If Left(Range("a" & Target.Row), 7) = "SALIDA" Then
' If Left(Range("a" & contador), 7) = "SALIDA" Then


cachar = Dir("\\D:\ALMACEN\VALES\SALIDA\" + texto + "*.pdf")
final = (Replace(cachar, " ", "%20", , , vbTextCompare))
' Range("b" & contador).Hyperlinks.Add Range("b" & contador), "Salida\" + final
' Range("b" & Target.Row).Hyperlinks.Delete
Selection.Hyperlinks.Add Target, "SALIDA\" + final
End If



End If 'de isnull
End If 'de la columna que se esta agregando hipervinculos
End If


'Next contador






Exit_Workbook_SheetChange:
Exit Sub

Err_vinculo:
MsgBox Err.Description
Resume Exit_Workbook_SheetChange

End Sub

****************************************************

saludos......
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Revisar política de publicidad