CODIGOS ABREVIADOS EXCEL Y OFFICE EN GENERAL

Click aqui

Salsa Chichoky

cancion mp3 Salsa Chichoky

ANCHO COLUMNA SEGUN VALOR CELDA

este codigo lo que hace es definir el ancho de la celda por el valor que contenga una celda.




code:

'hacer esto hasta que la celda activa de arriba sea vacia
Do Until ActiveCell.Offset(-1, 0).Value = ""
' para la seleccion de celda ancho= al valor de la celda de arriba
Selection.ColumnWidth = ActiveCell.Offset(-1, 0).Value
' desplazar a la derecha
ActiveCell.Offset(0, 1).Select

'repitis
Loop

Ejecutar un macro al cambiar una celda

Private Sub Worksheet_Change(ByVal Target As Range)
'pasamos a una variable, la celda o celdas
'que queremos evaluar si cambian o no
datos1 = "B5"
datos2 = "B7"
datos3 = "B12"
'como estamos dentro del evento "Change", algo tiene
'que estar cambiando... Pues bien, si la celda activa
'es la misma que la celda que hemos puesto en
'la variable llamada "datos", entonces
'que muestre un mensaje (recordemos que una doble
'negación es una afirmación)
If Not Application.Intersect(Target, Range(datos1)) Is Nothing Or _
Not Application.Intersect(Target, Range(datos2)) Is Nothing Or _
Not Application.Intersect(Target, Range(datos3)) Is Nothing Then
'mostramos un mensaje
MsgBox ("Oyeeeee, sé que estás cambiando alguna de estas celdas " & _
datos1 & ", " & datos2 & ", " & datos3 & ".")
End If
End Sub



Fuente

EVITAR DEJAR UNA CELDA EN BLANCO

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Row = 1 Then Exit Sub
If Selection.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
With Me.Range("A1")
.Value = .Value
End With
On Error GoTo Finish
If Not Target.Row = 1 Then
With Me.Range("A" & Target.Row).SpecialCells(xlCellTypeBlanks)
MsgBox "The range " & .Address(0, 0) & " is still blank"
.Select
End With
End If
Finish:
Application.EnableEvents = True
End Sub

CREAR LISTA DE HOJAS EN UNA NUEVA

Sub ListSheetNames()

Dim NumSheets
NumSheets = Sheets.Count

Application.DisplayAlerts = False
Dim i
For i = 1 To NumSheets + 1
If ActiveSheet.Name = "SheetNames" Then
Sheets("SheetNames").Select
ActiveWindow.SelectedSheets.Delete
Exit Sub
End If
Next i
Application.DisplayAlerts = True

Sheets.Add
ActiveSheet.Name = "SheetNames"
Sheets("SheetNames").Move after:=Sheets(NumSheets + 1)
'MsgBox (NumSheets)



For i = 1 To NumSheets
Range("A" & i) = Sheets(i).Name
Next i

End Sub