sábado, 24 de marzo de 2012

Impedir Acciones en Excel VBA




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