Access - Cuadro Combinado automatico

Private Sub AddPicture_Click()

    ' Utilice el cuadro de diálogo Abrir archivo de Office para obtener el nombre de un archivo que vaya a utilizar

    ' como la imagen de un empleado.

    getFileName

End Sub

Private Sub Form_RecordExit(Cancel As Integer)

    ' Oculte la etiqueta de mensajes de error

    'para minimizar el parpadeo durante la exploración

    ' entre registros.

    ErrorMsg.Visible = False

End Sub

Private Sub RemovePicture_Click()

Dim Resp As String

Resp = MsgBox("ESTA SEGURA DE ELIMINAR", vbCritical + vbYesNo, "ELIMINACION")

If Resp = vbYes Then

    ' Borre el nombre de archivo para el registro de empleado y muestre la

    ' etiqueta de mensajes de error.

    Me![ImagePath] = ""

    hideImageFrame

    ErrorMsg.Visible = True

Else

End If

End Sub

Private Sub Form_AfterUpdate()

    ' Consulte de nuevo el cuadro combinado ReportsTo una vez se haya modificado un registro.

    ' A continuación, muestre la etiqueta de mensajes de error si no existe ningún nombre de archivo para

    ' el registro de empleado o muestre la imagen si existe un nombre

    ' de archivo.

    On Error Resume Next

        showErrorMessage

        showImageFrame

        If (IsRelative(Me!ImagePath) = True) Then

        'Dim dir

        'dir = "\\Ml-server\dataserver\INTERCOM\SQL_SYSTEM"

            Me![ImageFrame].Picture = path & Me![ImagePath]  'path & 'dir &

        Else

            Me![ImageFrame].Picture = Me![ImagePath]

        End If

End Sub

Private Sub ImagePath_AfterUpdate()

    ' Una vez seleccionada una imagen para el empleado, muéstrela.

    On Error Resume Next

        showErrorMessage

        showImageFrame

        If (IsRelative(Me!ImagePath) = True) Then

            Me![ImageFrame].Picture = path & Me![ImagePath]

        Else

            Me![ImageFrame].Picture = Me![ImagePath]

        End If

End Sub

Private Sub Form_Current()

    ' Muestre la imagen para el registro actual del empleado, siempre que la imagen

    ' exista. Si el nombre de archivo no existe o está en blanco para

    ' el empleado actual, configure el título de la etiqueta de mensajes de error en el

    ' mensaje correspondiente.

    Codigo = Left(Vendedor, 6)

    Dim res As Boolean

    Dim fName As String

    path = CurrentProject.path

    On Error Resume Next

        ErrorMsg.Visible = False

        If Not IsNull(Me![Foto]) Then ''ubic

            res = IsRelative(Me![Foto])

            fName = path & Me![ImagePath] ' ******************* ojo **************

            If (res = True) Then

                fName = path & "\" & fName

            End If

            Me![ImageFrame].Picture = fName

            showImageFrame

            Me.PaintPalette = Me![ImageFrame].ObjectPalette

            If (Me![ImageFrame].Picture <> fName) Then

                hideImageFrame

                ErrorMsg.Caption = "No se encuentra la imagen"

                ErrorMsg.Visible = True

            End If

        Else

            hideImageFrame

            ErrorMsg.Caption = "Haga Click en Añadir/Cambiar para añadir imagen"

            ErrorMsg.Visible = True

        End If

End Sub

Sub getFileName()

    ' Muestre el cuadro de diálogo Abrir archivo de Office para elegir un nombre de archivo

    ' para el registro del empleado actual. Si el usuario selecciona un archivo,

    ' muéstrelo en el control de imagen.

    Dim fileName As String

    Dim result As Integer

    With Application.FileDialog(3) 'msoFileDialogFilePicker=3

        .Title = "Seleccione la imagen del Contrato"

        .Filters.Add "All Files", "*.*"

        .Filters.Add "JPEGs", "*.jpg"

        .Filters.Add "Bitmaps", "*.bmp"

        .FilterIndex = 3

        .AllowMultiSelect = False

        '************************  ojo *******************

        .InitialFileName = CurrentProject.path & "\CARP_ESC\CONTRATOS"  'CurrentProject.path  path

        result = .show

        If (result <> 0) Then

            fileName = Trim(.SelectedItems.Item(1))

            Me![ImagePath].Visible = True

            ImagePath.Enabled = True

            Me![ImagePath].SetFocus

            '********* proceso de quitar el path **********

            If Left(fileName, 1) <> "\" Then

            Dim Largo_PATH

            Dim Largo_File, Dif

            Largo_PATH = Len(CurrentProject.path)

            Largo_File = Len(fileName)

            Dif = Largo_File - Largo_PATH

            fileName = Right(fileName, Dif)

            Me![ImagePath].Text = fileName

            Else

            Me![ImagePath].Text = fileName

            End If

            '************************************************

            Me![Cedula].SetFocus

            Me![ImagePath].Visible = False

            ImagePath.Enabled = False

        End If

    End With

End Sub

Sub showErrorMessage()

    ' Muestre la etiqueta de mensajes de error si el archivo de imagen no se encuentra disponible.

    If Not IsNull(Me![Foto]) Then

        ErrorMsg.Visible = False

    Else

        ErrorMsg.Visible = True

    End If

End Sub

Function IsRelative(fName As String) As Boolean

    ' Devuelva el valor falso si el nombre de archivo contiene una unidad o ruta de acceso UNC

    IsRelative = (InStr(1, fName, ":") = 0) And (InStr(1, fName, "\\") = 0)

End Function

Sub hideImageFrame()

    ' Oculte el control de imagen

    Me![ImageFrame].Visible = False

End Sub

Sub showImageFrame()

    ' Muestre el control de imagen

    Me![ImageFrame].Visible = True

End Sub

Private Sub SALIR_Click()

On Error GoTo Err_SALIR_Click

    DoCmd.Close

Exit_SALIR_Click:

    Exit Sub

Err_SALIR_Click:

    MsgBox Err.Description

    Resume Exit_SALIR_Click

End Sub

Option Compare Database

Option Explicit

Private Sub CmdAceptar_Click()

On Error GoTo err:

'variable local para nombre y clave de usuario

Dim NOMUSU As String

Dim CVEUSU As String

'Asignar el valor de los controles a las variables locales

NOMUSU = UCase(Nz(Me.TxtNOMBRE_USUARIO.Value, ""))

CVEUSU = UCase(Nz(Me.TxtCLAVE_USUARIO.Value, ""))

If IsEmpty(NOMUSU) Or IsEmpty(CVEUSU) Then

        MsgBox "Datos Incompletos...", vbOKOnly + vbCritical, "Imposible Ingresar!!"

    Else

        'Buscar Usuario con los datos ingresados

        If ExisteUsuario(NOMUSU, CVEUSU) = True Then

                MsgBox "Bienvenido al Sistema", vbOKOnly + vbInformation, "Acceso Exitoso"

                DoCmd.Close 'Cerrar ventana de Acceso

                DoCmd.OpenForm "VENTAS", acNormal

            Else

                NumIntento = NumIntento + 1

                If NumIntento <= 2 Then

                        MsgBox "Usuario o Clave incorrecta", vbCritical + vbOKOnly, "Acceso Denegado"

                        Me.TxtNOMBRE_USUARIO.Value = ""

                        Me.TxtCLAVE_USUARIO.Value = ""

                        Me.TxtNOMBRE_USUARIO.SetFocus

                    Else

                        MsgBox "Demasiados Intentos, el Sistema se cerrara!", vbCritical + vbOKOnly, "Fallas de Acceso"

                        DoCmd.Quit

                End If

        End If

End If

Exit Sub

err:

MsgBox err.Description

End Sub

Public Function ExisteUsuario(strNomUsuario As String, strCveUsuario As String) As Boolean

On Error GoTo us_err

Dim Rst As DAO.Recordset

Dim sql As String

sql = "SELECT * FROM [USUARIOS] US WHERE US.[NOMBRE_USUARIO]='" & strNomUsuario & "' AND US.[CLAVE_USUARIO]='" & strCveUsuario & "'"

Set Rst = CurrentDb.OpenRecordset(sql)

If Rst.BOF And Rst.EOF Then

        ExisteUsuario = False

    Else

        ExisteUsuario = True

        'Se Inicializar las variables de Sesion

        xNOMBRE_USUARIO = Rst!NOMBRE_USUARIO

        xCLAVE_USUARIO = Rst!CLAVE_USUARIO

        xNOMBRE = Rst!NOMBRE

        xAPELLIDO_PATERNO = Rst!APELLIDO_PATERNO

        xAPELLIDO_MATERNO = Rst!APELLIDO_MATERNO

        xVENTAS = Rst!VENTAS

        xADMINISTRAR = Rst!ADMINISTRAR

        xREPORTES = Rst!REPORTES

        xCATALOGOS = Rst!CATALOGOS

        xCONSULTAS = Rst!CONSULTAS

        xCANCELAR_VENTA = Rst!CANCELAR_VENTA

End If

Rst.Close

Set Rst = Nothing

Exit Function

us_err:

MsgBox err.Description

End Function

Private Sub TxtCLAVE_USUARIO_Enter()

s

End Sub

Private Sub TxtCLAVE_USUARIO_KeyUp(KeyCode As Integer, Shift As Integer)

hi

End Sub