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.

Sub fixRowHeights()
   For i = 1 To 1000
      ThisWorkbook.ActiveSheet.Rows(i).RowHeight = 19
   Next i
End Sub

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