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 de Dante Amor
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 Jot@"
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 Jot@"
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 explicit@ 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
