Control de acceso con excel
0 likes159 views
This document contains VBA code for Excel that defines macros and userforms. It includes code to: 1. Activate worksheets and show userforms on workbook open and worksheet activate events. 2. Validate user credentials against a table to control the visibility of different worksheets. 3. Allow moving and closing userforms without captions using API calls.
More Related Content
What's hot (19)
Similar to Control de acceso con excel (20)
![[2024] An Introduction to Functional Programming with Go [Y Combinator Remix]...](https://cdn.slidesharecdn.com/ss_thumbnails/2024anintroductiontofunctionalprogrammingwithgoycombinatorremix-241007114312-7e90a89d-thumbnail.jpg?width=560&fit=bounds)
Recently uploaded (20)
Control de acceso con excel
- 1. Hoja6 - 1 Private Sub Worksheet_Activate() Sheets("INICIO").ScrollArea = ("A1:A10") Cambiauser.Show Modeless End Sub
- 2. ThisWorkbook - 1 Private Sub Workbook_BeforeClose(Cancel As Boolean) Call oculta End Sub Private Sub Workbook_Open() Sheets("INICIO").ScrollArea = ("A1:A10") Call oculta UserForm1.Show End Sub
- 3. Cambiauser - 1 'Option Explicit Const GWL_STYLE = -16 Const WS_CAPTION = &HC00000 Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd A s Long, ByVal nIndex As Long) As Long Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWin dowName As String) As Long 'Posici¨®n del formulario Dim FormX As Double, FormY As Double Private Sub CommandButton1_Click() Call oculta UserForm1.Show End Sub Private Sub CommandButton2_Click() Call CERRAR End Sub Private Sub UserForm_Initialize() Dim lngWindow As Long, lFrmHdl As Long lFrmHdl = FindWindowA(vbNullString, Me.Caption) lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE) lngWindow = lngWindow And (Not WS_CAPTION) Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow) Call DrawMenuBar(lFrmHdl) End Sub Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If Button = 1 Then FormX = X FormY = Y End If End Sub Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If Button = 1 Then Me.Left = Me.Left + (X - FormX) Me.Top = Me.Top + (Y - FormY) End If End Sub Private Sub CloseButton_Click() Unload Me End Sub
- 4. UserForm1 - 1 'Option Explicit Const GWL_STYLE = -16 Const WS_CAPTION = &HC00000 Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd A s Long, ByVal nIndex As Long) As Long Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWin dowName As String) As Long 'Posici¨®n del formulario Dim FormX As Double, FormY As Double Private Sub CommandButton1_Click() Call acceso End Sub Private Sub CommandButton2_Click() Call CERRAR End Sub Private Sub UserForm_Initialize() Dim lngWindow As Long, lFrmHdl As Long lFrmHdl = FindWindowA(vbNullString, Me.Caption) lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE) lngWindow = lngWindow And (Not WS_CAPTION) Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow) Call DrawMenuBar(lFrmHdl) TextBoxU = "" TextBoxC = "" End Sub Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If Button = 1 Then FormX = X FormY = Y End If End Sub Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If Button = 1 Then Me.Left = Me.Left + (X - FormX) Me.Top = Me.Top + (Y - FormY) End If End Sub
- 5. M¨®dulo1 - 1 Sub acceso() Dim TablaUsuarios As Range Dim usuario, clave As String On Error GoTo advr Sheets("INICIO").Activate Range("XFC1").Select Set TablaUsuarios = Range("XFC2:XFD5") usuario = UserForm1.TextBoxU clave = UserForm1.TextBoxC clavecorrecta = Application.WorksheetFunction.VLookup(usuario, TablaUsuarios, 2, False) If clavecorrecta <> clave Then GoTo advr If clave = "anax" Then Sheets("GONIOMETRICA").Visible = -1 Sheets("GONIOMETRICA").Activate Sheets("Gr¨¢fico y=ax?+bx+c").Visible = -1 ElseIf clave = "pepe" Then Sheets("SENO").Visible = -1 Sheets("SENO").Activate ElseIf clave = "rompe" Then Sheets("Sistema de 3 ecuaciones").Visible = -1 Sheets("Sistema de 3 ecuaciones").Activate ElseIf clave = "anac" Then Sheets("Gr¨¢fico y=ax+b").Visible = -1 Sheets("Gr¨¢fico y=ax+b").Activate End If Unload UserForm1 End advr: Ouch = MsgBox("EL USUARIO, LA CLAVE O AMBOS" & Chr(13) _ & "SON ERRONEOS", vbCritical) End Sub Sub oculta() Sheets("GONIOMETRICA").Visible = 2 Sheets("SENO").Visible = 2 Sheets("Sistema de 3 ecuaciones").Visible = 2 Sheets("Gr¨¢fico y=ax+b").Visible = 2 Sheets("Gr¨¢fico y=ax?+bx+c").Visible = 2 End Sub Private Sub muestra() Sheets("GONIOMETRICA").Visible = -1 Sheets("SENO").Visible = -1 Sheets("Sistema de 3 ecuaciones").Visible = -1 Sheets("Gr¨¢fico y=ax+b").Visible = -1 Sheets("Gr¨¢fico y=ax?+bx+c").Visible = -1 End Sub
- 6. M¨®dulo1 - 2 Sub CERRAR() SIONO = MsgBox("?SEGURO QUE QUIERE SALIR?", vbYesNo) If SIONO = vbYes Then Unload UserForm1 ActiveWorkbook.Close End If End Sub Sub lanza_form() UserForm1.Show End Sub