Evento Exit del Textbox2 en VBA Excel Comparar existencia

Para DanteAmor

Dante No voy a interrumpirte el fin de semana, dejalo para lunes.

En la misma plantilla (ultima) Celdas N_T combinadas_formato person en D

Llenado el cuadro de texto, Producto (TextBox2) saliendo de este, si lo escrito en el TextBox2 (producto) ya existe en la hoja columna C11:C46 y N11:N46, darme mensaje = MsgBox "Intenta introducir un renglón ya existente. Puede editar el existente si prefiere" Salir de la macro Exit Sub

1 respuesta

Respuesta
1

Manejar el exit en un textbox, a veces, se torna complicado. Estoy declarando una variable "saliendo", para cuando estás en el textbox2, pero decides cerrar el userform.

Te anexo todo el código

Const GWL_STYLE = -16
Const WS_CAPTION = &HC00000
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Dim colTbxs As Collection
Dim saliendo
'
Private Sub CheckBox1_Click()
'Por Dante amor http://www.todoexpertos.com/preguntas/6gjby9n8rtox64wr/centrar-formulario-excel-en-pantalla
    Dim i
    If CheckBox1 Then
    For i = 2 To 4
        Controls("CheckBox" & i).Value = False
        ComboBox1 = ""
        ComboBox1.Visible = False
        frmLista.Height = 192
        frmLista.StartUpPosition = 2 'CENTRAR EL FORMULARIO
        frmLista.Show
    Next
        For i = 1 To 5
            Controls("TextBox" & i).Visible = False
            Controls("Label" & i).Visible = False
            cmbInsertar.Top = 155: cmbCerrar.Top = 155
            CheckBox1.Top = 155: CheckBox2.Left = 354: CheckBox2.Top = 155:
            CheckBox3.Visible = False
            CheckBox4.Visible = False
        Next
        For i = 7 To 12
            Controls("TextBox" & i).Visible = True
            Controls("TextBox" & i).Top = 18
            Controls("Label" & i).Visible = True
            Controls("Label" & i).Top = 6
            DTPicker1.Top = 18
            DTPicker1.Visible = True
            TextBox12.Top = 71: Label12.Top = 53: Label13.Top = 53
            Label13.Visible = True: Label6.Top = 6: Label6.Visible = True
            For o = 1 To 2
                Controls("OptionButton" & o).Top = 53
                Controls("OptionButton" & o).Visible = True
            Next
        Next
        DTPicker1 = Date
        CheckBox1.Caption = "DESmarca para insertar productos"
    Else
        frmLista.Height = 120
        frmLista.StartUpPosition = 2 'CENTRAR EL FORMULARIO
        frmLista.Show
        ComboBox1.Visible = True
        CheckBox2.Value = False
        For i = 1 To 5
            Controls("TextBox" & i).Visible = True
            Controls("TextBox" & i) = ""
            Controls("label" & i).Visible = True
            cmbInsertar.Top = 82: cmbCerrar.Top = 82
            CheckBox1.Top = 82: CheckBox2.Top = 48: CheckBox2.Left = 154
            CheckBox3.Visible = True
            CheckBox4.Visible = True
        Next
        For i = 7 To 12
            Controls("TextBox" & i).Visible = False
            Controls("TextBox" & i) = ""
            Controls("Label" & i).Visible = False
            Label13.Visible = False
            DTPicker1.Visible = False: Label6.Visible = False
            For o = 1 To 2
                Controls("OptionButton" & o) = False
                Controls("OptionButton" & o).Visible = False
            Next
            TextBox1.SetFocus
        Next
        CheckBox1.Caption = "Marca para insertar datos finales"
    End If
End Sub
Private Sub CheckBox2_Click()
'Act.Por.Dante Amor
    Dim i
    '
    'Si está activo el check de datos de identificación, entonces es para
 'modificar los datos de identificación
    If CheckBox1 And CheckBox2 Then
        If OptionButton1 = False And OptionButton2 = False Then
            MsgBox "Selecciona una página"
            CheckBox2 = False
            Exit Sub
        End If
        If OptionButton1 Then
            DTPicker1 = Range("C8")  'Fecha
            TextBox7 = Range("E8")   'Nombre Empresa
            TextBox8 = Range("J8")   'Repuestos para
            TextBox9 = Range("D9")   'Serial Maq/Mot.
            TextBox10 = Range("G9")  'Marca
            TextBox11 = Range("K9")  'Modelo/Ident.
            TextBox12 = Range("D47") 'Notas
            Exit Sub
        Else
            DTPicker1 = Range("N8")  'Fecha
            TextBox7 = Range("p8")   'Nombre Empresa
            TextBox8 = Range("U8")   'Repuestos para
            TextBox9 = Range("O9")   'Serial Maq/Mot.
            TextBox10 = Range("R9")  'Marca
            TextBox11 = Range("V9")  'Modelo/Ident.
            TextBox12 = Range("O47") 'Notas
            Exit Sub
        End If
    End If
    '
    If CheckBox2 Then
''''''''''
        Call CargaCombobox2
''''''''''
    Else
        ComboBox1.Enabled = False
        Call Limpiar
        ComboBox1 = ""
    End If
End Sub
'
Sub CargaCombobox2()
    With ComboBox1
        .Enabled = True
        'carga nuevamente el combo con los nuevos registros
        .Clear
        For i = 11 To 46 'Range("B" & Rows.Count).End(xlUp).Row 'original ("B"
            If Cells(i, "B") <> "" Then
                .AddItem Cells(i, "C") '1ª columna C ComboBox
                .List(ComboBox1.ListCount - 1, 1) = Cells(i, "D") '2ª columna D ComboBox
                .List(ComboBox1.ListCount - 1, 2) = i
                .List(ComboBox1.ListCount - 1, 3) = Columns("B").Column
            End If
        Next
        For i = 11 To 46
            If Cells(i, "N") <> "" Then
                .AddItem Cells(i, "N")
                .List(ComboBox1.ListCount - 1, 1) = Cells(i, "O")
                .List(ComboBox1.ListCount - 1, 2) = i
                .List(ComboBox1.ListCount - 1, 3) = Columns("M").Column
            End If
        Next
    End With
End Sub
Private Sub CheckBox3_Click()
    If CheckBox3 Then
        With TextBox4
            .ForeColor = vbRed 'RGB(255, 0, 0)
            .Font.Bold = True
        End With
    Else
        With TextBox4
            .ForeColor = &H80000008
            .Font.Bold = False
        End With
    End If
End Sub
Private Sub CheckBox4_Click()
Dim i
 If CheckBox4 Then
    For i = 1 To 5
        With Controls("TextBox" & i)
            .ForeColor = vbRed 'RGB(255, 0, 0)
            .Font.Bold = True
        End With
    Next i
 Else
    For i = 1 To 5
       With Controls("TextBox" & i)
            .ForeColor = &H80000008
            .Font.Bold = False
        End With
    Next
 End If
End Sub
Private Sub cmbCerrar_Click()
    Unload Me
    saliendo = True
End Sub
Private Sub cmbInsertar_Click() 'validar datos
insertar
End Sub
Sub insertar()
'Por.Dante Amor http://www.todoexpertos.com/preguntas/6dfdswlh5iak7bjd/correccion-para-macro-excel-para-insertar-datos-mandando-error
'Obligar a llenar las cajas del 6 al 9
    Dim vcs, vtx, LastRow, u ', i
    Dim i As Double
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="By [email protected]"
    Errores = False 'variable para verificar uno a uno o TODOS A LA VES los TextBox
'Insertar Ultimos datos
    If CheckBox1 Then
'Mensage sobre TextBox para Datos Finales
        '
        If OptionButton1 = False And OptionButton2 = False Then
            MsgBox "Selecciona una página"
            Exit Sub
        End If
        '
        vcs = Array("DTPicker1", "Textbox7", "Textbox8", "Textbox9", "Textbox10", "Textbox11")
        vtx = Array("UNA FECHA VALIDA", "EL NOMBRE DE EMPRESA", "REPESTOS PARA", "EL SERIAL MAQ/MOT", "LA MARCA", "EL MODELO/IDENT.")
        For i = LBound(vcs) To UBound(vcs)
            If Me.Controls(vcs(i)) = Empty Then
                MsgBox "DEBES INTRODUCIR: " & vtx(i), vbExclamation, "LLENAR LISTA"
                Me.Controls(vcs(i)).SetFocus
                'Exit Sub 'Colocado este aqui, verifica uno a uno los TextBox. No hace parte de la variable errores
                Errores = True
            End If
            If Errores Then Exit Sub 'Colocado aqui, verifica uno a uno los TextBox
        Next
        'If errores Then Exit Sub 'Colocado aqui, verifica TODOS TextBox a la ves
        '
        'If Range("c8") = "" Then 'SI LA C8 ESTA VACIA, INSERTA EN LA 1ª PAGINA
        If OptionButton1 Then
            Range("C8") = DTPicker1  'Fecha
            Range("E8") = TextBox7  'Nombre Empresa
            Range("J8") = TextBox8  'Repuestos para
            Range("D9") = TextBox9  'Serial Maq/Mot.
            Range("G9") = TextBox10 'Marca
            Range("K9") = TextBox11 'Modelo/Ident.
            Range("D47").Value = Left(TextBox12.Value, 450) 'Notas
        Else 'Si encuentra la C8 ya llena inserta en la 2ª pagina
            Range("N8") = DTPicker1  'Fecha
            Range("P8") = TextBox7  'Nombre Empresa
            Range("U8") = TextBox8  'Repuestos para
            Range("O9") = TextBox9  'Serial Maq/Mot.
            Range("R9") = TextBox10 'Marca
            Range("V9") = TextBox11 'Modelo/Ident.
            Range("O47").Value = Left(TextBox12.Value, 450) 'Notas
        End If
        TextBox7.SetFocus
''''''''''''
    Else
'Mensage sobre TextBox para Productos
        vcs = Array("TextBox1", "Textbox2", "Textbox3", "Textbox4", "Textbox5")
        vtx = Array("UN ITEM", "EL # DE PRODUCTO", "LA DESCRIPCION DEL PRODUCTO", "LA CANTIDAD", "EL # DE PAGINA")
        For i = LBound(vcs) To UBound(vcs)
            If Me.Controls(vcs(i)) = Empty Then
                MsgBox "DEBES INTRODUCIR: " & vtx(i), vbExclamation, "LLENAR LISTA"
                'Exit Sub 'Colocado este aqui, verifica uno a uno los TextBox. No hace parte de la variable errores
                Me.Controls(vcs(i)).SetFocus
                Errores = True
            End If
                If Errores Then Exit Sub 'Colocado aqui, verifica uno a uno los TextBox
        Next
            'If errores Then Exit Sub 'Colocado aqui, verifica TODOS TextBox a la ves
        If CheckBox2 Then
            'modifica producto
            fil = Val(ComboBox1.List(ComboBox1.ListIndex, 2))
            col = Val(ComboBox1.List(ComboBox1.ListIndex, 3))
        Else
            'inserta producto
            fil = 11
            col = Columns("B").Column
            Do While Cells(fil, col) <> ""
                fil = fil + 1
                If fil = 47 Then col = Columns("M").Column: fil = 11
            Loop
        End If
'''''
        wcolor = vbBlack: wbold = False
        If CheckBox4 Then wcolor = 3: wbold = True
        Call Formatear(fil, col, wcolor, wbold, TextBox1.Value)
        Call Formatear(fil, col + 1, wcolor, wbold, TextBox2.Value)
        Call Formatear(fil, col + 2, wcolor, wbold, TextBox3.Value)
        Call Formatear(fil, col + 8, wcolor, wbold, TextBox4.Value)
        Call Formatear(fil, col + 9, wcolor, wbold, TextBox5.Value)
        '
        wcolor = vbBlack: wbold = False
        If CheckBox3 Then
          wcolor = 3: wbold = True
          Cells(fil, col) = TextBox1          'Item #
          Cells(fil, col + 1) = TextBox2      'Producto #
          Cells(fil, col + 2) = TextBox3      'Descripcion del Producto
          Cells(fil, col + 8) = TextBox4      'Cant.
          Cells(fil, col + 8).Font.ColorIndex = wcolor
          Cells(fil, col + 8).Font.Bold = wbold
          Cells(fil, col + 9) = TextBox5      'Pagina #
       End If
'''''
        Call CargaCombobox2
        TextBox1.SetFocus
    End If
    ActiveSheet.Protect Password:="By [email protected]"
    Application.ScreenUpdating = True
    Call Limpiar
    ComboBox1 = ""
    'Subir la hoja
    If Range("C46") = "" Then
        'Obtener la última fila con datos de la columna B
        u = Range("B" & Rows.Count).End(xlUp).Row
        'Si la ventana tiene los paneles inmovilizados, entonces n va a ser igual a 10 de lo contrario n =17
        If ActiveWindow.FreezePanes = True Then n = 16 Else n = 23  'original es 10  17
        'Ahora si la última fila con dato es mayor a 17, significa que tengo que mover los datos de la ventana "scroll"
        'Entonces voy a mover la ventana haciendo un scroll hasta la última fila pero le resto las filas que quiero que permanezcan visibles.
        If u > 23 Then ActiveWindow.ScrollRow = u - n
    Else
        'Obtener la última fila con datos de la columna M
        u = Range("M" & Rows.Count).End(xlUp).Row
        If ActiveWindow.FreezePanes = True Then n = 16 Else n = 23 'original es 10  17 Se puede jugar con estos números
        If u > 23 Then ActiveWindow.ScrollRow = u - n 'Original 17
    End If
End Sub
Sub Formatear(fil, col, wcolor, wbold, wtext)
    Cells(fil, col) = wtext
    Cells(fil, col).Font.ColorIndex = wcolor
    Cells(fil, col).Font.Bold = wbold
    If CheckBox4 Then
        Cells(fil, col).Interior.ColorIndex = 43
    Else
        Cells(fil, col).Interior.ColorIndex = 0
    End If
End Sub
Private Sub ComboBox1_Change()
'Por.Dante Amor
    'Llenar textbox
    Dim f
    If ComboBox1.ListIndex = -1 Then
        TextBox1 = ""
        TextBox2 = ""
        TextBox3 = ""
        TextBox4 = ""
        TextBox5 = ""
        Exit Sub
    End If
    f = Val(ComboBox1.List(ComboBox1.ListIndex, 2))
    c = Val(ComboBox1.List(ComboBox1.ListIndex, 3))
    TextBox1 = Cells(f, c)
    TextBox2 = Cells(f, c + 1)
    TextBox3 = Cells(f, c + 2)
    TextBox4 = Cells(f, c + 8)
    TextBox5 = Cells(f, c + 9)
End Sub
Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
                                ByVal x As Single, ByVal Y As Single)
ComboBox1.DropDown
End Sub
Private Sub DTPicker1_Change()
TextBox7.SetFocus
End Sub
Private Sub OptionButton1_Click()
CheckBox2 = False
End Sub
Private Sub OptionButton2_Click()
CheckBox2 = False
End Sub
Private Sub TextBox1_Change()
    TextBox1 = Format(TextBox1, "000")
End Sub
Private Sub TextBox10_Change()
TextBox10.Text = UCase(TextBox10.Text)
End Sub
Private Sub TextBox12_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then insertar
End Sub
Private Sub TextBox12_Change()
'Dar propiedades de MaxLength 450 al textBox12 para conteo reversible
Label13 = 450 - VBA.Len(TextBox12)
If VBA.Len(TextBox12) > 449 Then MsgBox "Llegaste al MAX de caracteres permitidos" & vbCr & vbCr & _
"Trata de ser [email protected] y entendible en tu Nota/Observación", vbInformation, "Información": Exit Sub
End Sub
Private Sub TextBox2_Change()
    TextBox2.Text = UCase(TextBox2.Text)
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If saliendo Or TextBox2 = "" Then Exit Sub
    Set r = Range("C11:C46, N11:N46")
    Set b = r.Find(TextBox2, lookat:=xlWhole)
    If Not b Is Nothing Then
        MsgBox "Intenta introducir un renglón ya existente. " & _
               "Puede editar el existente si prefiere"
        Cancel = True
    End If
End Sub
Private Sub TextBox3_Change()
    TextBox3.Text = UCase(TextBox3.Text)
End Sub
Private Sub TextBox5_Change()
    TextBox5.Text = UCase(TextBox5.Text)
End Sub
Private Sub TextBox5_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then insertar
End Sub
Private Sub TextBox9_Change()
    TextBox9.Text = UCase(TextBox9.Text)
End Sub
Private Sub UserForm_Initialize()
    Dim celda
'Ocutar barra de titulo
    Dim lngWindow As Long, lFrmHdl As Long
    frmLista.Height = 116
    frmLista.Width = 579.75
    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)
'Cargar combo
    With ComboBox1
        .Clear
    For Each celda In Range("C11:C" & Range("B" & Rows.Count).End(xlUp).Row) 'original("D11:D"
        If celda <> Empty Then
            .AddItem celda.Value
        ''''''''''''
            .List(ComboBox1.ListCount - 1, 1) = celda.Offset(0, 1)
        End If
        ''''''''''''
    Next
    End With
'Cargar textbox
    Dim ctlLoop As MSForms.Control
    Dim clsObject As Clase1
'Create New Collection To Store Custom Textboxes
    Set colTbxs = New Collection
'Bucle a través de controles en Userform
    For Each ctlLoop In Me.Controls
'Compruebe si el Control es un control Textbox
        ''If TypeOf ctlLoop Is MSForms.TextBox Then 'PROBAR ACTIVAR este, el Case y el End If
            Select Case ctlLoop.Name
'agregar los textbox con su nombre propio que sí entran en Tipo Titulo cada palabra de una frase
            ''Case "TextBox3", "TextBox7", "TextBox8", "TextBox10", "TextBox11"
    Case "TextBox7", "TextBox8", "TextBox11"
'Crear una nueva instancia de la clase del controlador de eventos
                minom = ctlLoop.Name
                If TypeOf ctlLoop Is MSForms.TextBox Then
'Crear una nueva instancia de la clase de controlador de eventos
                    Set clsObject = New Clase1
'Establecer la nueva instancia para controlar los eventos de nuestro cuadro de texto
                    Set clsObject.tbxCustom1 = ctlLoop
'Agregar el controlador de eventos a nuestra colección
                    colTbxs.Add clsObject
                End If
        End Select
        ''End If
    Next ctlLoop
    saliendo = False
End Sub 'Fin cargar textbox

Lo recomendable es que hagas la validación en el botón insert

Sal u dos

Tu eres el que sabe, yo voy por tu recomendación.

Podía ser en el botón Insertar, pero no cerrar el form para poder continuar, es decir, salir de la macro sin cerrar el form

Perdona mi ignorancia Dante

¿Qué beneficio tengo en este caso?

Me manda mensaje y le doy Aceptar al mensaje, CORRECTO

Pero si decido Cerrar el form no me deja apareciendo siempre el mensaje cada ves que piso CERRAR

¿Cuál el beneficio?

Claro que así, daría para buscar cualquier registro en caso de querer saber si ya esta o no registrado, pero claro está que está echo para que siga registrando.

Puedo hacer que al Aceptar en el MsgBox, limpie el textbox2 y así si deja salir si es el caso.

Voy prueba

Desactive el Cancel = True

Alguna sugerencia de si bien o mal?

Para salir tienes que poner en blanco el textbox

Creo la mejor opción se como hacerlo al Aceptar en el MSGBOX, pero ¿no tengo que desactivar la línea

Cancel = True

?

No la desactives. Es para regresar al textbox en caso de error

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas