Para evitar que durante la ejecución de una macro se vean todos los movimientos y cambios del cursor, para evitar las "chirivitas" que se ven al ejecutar una macro: Al principio de la macro escribe Application.ScreenUpdating = False y al final Application.ScreenUpdating = True ------------------------------------------------------------------------- Impedir que al ejecutar una macro nos haga preguntas Al principio de la macro escribe Application.DisplayAlerts= False y al final Application.DisplayAlerts=True ------------------------------------------------------------------------- Impedir Abrir Libro Sub noCopiar() 'si la ruta no es la especificada If ThisWorkbook.Path <> _ "E:\TUTORIALES\Excel\Execeluciones\Mis pruebas\seguridad en excel" Then ThisWorkbook.Close False 'cierra el archivo End If End Sub 'adaptado de una idea de Hector Miguel 'http://groups.google.com/group/microsoft.public.es.excel/browse_thread/thread/8fac1f6391126228/74d7b0fbb1e9828d?hl=es#74d7b0fbb1e9828d 'requiere el uso obligatorio de habilitar macros ------------------------------------------------------------------------- Impedir cambio de nombre a la hoja ' Private Sub Worksheet_Deactivate() If Hoja1.Name <> "Normal" Then Hoja1.Name = "Normal" End Sub ------------------------------------------------------------------------- Impedir Guardar Como Private Sub workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim lReply As Long If SaveAsUI = True Then lReply = MsgBox("Lo siento, no le está permitido salvar este" & " " & "libro con otro nombre ó extensión. ¿Desea guardar este" & " " & "libro de trabajo?", vbQuestion + vbOKCancel) Cancel = (lReply = vbCancel) If Cancel = False Then Me.Save Cancel = True End If End Sub Private Sub workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim lReply As Long If SaveAsUI = True Then lReply = MsgBox("Lo siento, No tiene permiso para guardar este libro con otro nombre. " _ & "¿Desea guardarlo con el mismo nombre?.", vbQuestion + vbOKCancel) Cancel = (lReply = vbCancel) If Cancel = False Then Me.Save Cancel = True End If End Sub ------------------------------------------------------------------------- Impedir Imprimir Private Sub workbook_BeforePrint(Cancel As Boolean) Cancel = True MsgBox "Lo siento, No puede imprimir este libro", vbInformation End Sub Private Sub workbook_BeforePrint(Cancel As Boolean) Select Case ActiveSheet.Name Case "Sheet1", "Sheet2" Cancel = True MsgBox "Lo siento, No puede imprimir esta hoja de este libro", vbInformation End Select End Sub ------------------------------------------------------------------------- Impedir Vista Previa Imprimir Private Sub Workbook_BeforePrint(Cancel As Boolean) Cancel = True End Sub ------------------------------------------------------------------------- Impedir Inserte Hojas Private Sub Workbook_NewSheet(ByVal Sh As Object) Application.DisplayAlerts = False MsgBox "Lo siento, No puede añadir nuevas hojas de calculo a este libro", vbInformation Sh.Delete Application.DisplayAlerts = True End Sub ------------------------------------------------------------------------- Ultima Columna Ocupada y Libre uc = Cells(1, 255).End(xlToLeft).Column uc = Cells(1, 255).End(xlToLeft).Column + 1 lastRow = Hoja1.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column ------------------------------------------------------------------------- Ultima Fila Ocupada y Libre LastRow = MiHoja.Cells.Find("*",SearchOrder:=xlByRows,SearchDirection:=xlPrevious).Row LastRow = ActiveSheet.UsedRange.Rows.Count LastRowColA = Hoja2.Range("A65536").End(xlUp).Row LastRow = Hoja2.Cells.SpecialCells(xlCellTypeLastCell).Row filalibre = Range("A1").End(xlDown).Offset(1, 0).Row filalibre = ActiveSheet.Range("A1").End(xlDown).Offset(1, 0).Row 'Select filalibre = ActiveSheet.Range("A1", ActiveSheet.Range("A65536")).End(xlUp).Select filalibre = ActiveSheet.Range("A1" & ActiveSheet.Range("A65536")).End(xlUp.Address).select strfila$ = Sheets("Hoja2").[A65536].End(xlUp).Offset(1, 0).Row Sub FinalLista() Worksheets("Socios").Select Range("A1").Select While ActiveCell.Value <> "" ActiveCell.Offset(1, 0).Range("A1").Select Wend End Sub ------------------------------------------------------------------------- SubFinalLista1() Sheets("Socios").Activate Sheets("Socios").Range("A1").Select Do While ActiveCell <> Empty ActiveCell.Offset(1, 0).Select Loop End Sub Sub UltimoReg1() i = 1 While Worksheets("Hoja3").Cells(i, 1).Value <> "" Worksheets("Hoja3").Cells(i, 1).Select i = i + 1 Wend End Sub