Sub fixRowHeights()
For i = 1 To 1000
ThisWorkbook.ActiveSheet.Rows(i).RowHeight = 19
Next i
End Sub
martes, julio 21, 2015
Ajustar el tamaño de las 1000 primeras filas a un tamaño determinado.
Ajustar el tamaño de las 1000 primeras filas a un tamaño determinado.
viernes, julio 17, 2015
Función que genera hipervínculos a las pestañas del Libro si estas existen.
'UTIL
Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
On Error Resume Next
WorksheetExists = (Sheets(WorksheetName).Name <> "")
On Error GoTo 0
End Function
Sub GenHyperlinks()
Dim i As Long
Sheets("Taller").Activate
i = 2
'El link va en el primer registro de la tabla
While Range("A" & i).Value <> ""
If Range("D" & i).Value = "1" Then
'Si ya tiene enlace no recrear
If Range("A" & i).Hyperlinks.Count = 0 Then
'Si la hoja existe crear el enlace
If WorksheetExists(Range("A" & i).Value) Then
'Create link
Range("A" & i).Hyperlinks.Add _
Anchor:=Range("A" & i), _
Address:="", _
SubAddress:=Range("A" & i).Value & "!A1", _
ScreenTip:=Range("A" & i).Value, _
TextToDisplay:=Range("A" & i).Value
End If
End If
End If
i = i + 1
DoEvents
Wend
End Sub
VBA - Convertir enlaces absolutos en enlaces relativos
Función que convierte todos los enlaces absolutos de un archivo a enlaces relativos.
(Sólo usar cuando el archivo sólo contenga enlaces a él mismo)
Así podemos modificar el nombre y la ubicación del archivo sin que fallen los hipervínculos.
'Convierte en relativos todos los enlaces de un Libro eliminando las referencias externas a otros archivos.
Sub FixHyperlinks()
Dim hyp As Hyperlink
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
For Each hyp In sh.Hyperlinks
hyp.Address = ""
Next hyp
Next sh
MsgBox ("Los hipervínculos se actualizaron corréctamente")
End Sub
Suscribirse a:
Comentarios (Atom)