UserForm no cambie de hoja
Tengo un UserForm para dar de alta, editar y eliminar registros en una hoja de excel, pero deseo abrirlo (el UserForm) desde otra hoja, mi prblema es que al cargar los registros al ComboBox y elegir una entrada, se cambia de hoja a la hoja donde inicialmente lo tenia, se puede evitar esto, es decir ¿qué todo lo haga desde la hoja donde se abre?
1 respuesta
Pon aquí el código para realizar los ajustes.
Private Sub cmd_Agregar_Click()
Dim i As Integer
If cbo_Nombre.Text = "" Then
MsgBox ZNOVALIDO, vbInformation + vbOKOnly, ZCOPYRIGHT
cbo_Nombre.SetFocus
Exit Sub
End If
If Not (Mid(cbo_Nombre.Text, 1, 1) Like "[a-z]" Or Mid(cbo_Nombre.Text, 1, 1) Like "[A-Z]") Then
MsgBox ZNOVALIDO, vbInformation + vbOKOnly, ZCOPYRIGHT
cbo_Nombre.SetFocus
Exit Sub
End If
For i = 2 To Len(cbo_Nombre.Text)
If Mid(cbo_Nombre.Text, i, 1) Like "#" Then
MsgBox ZNOVALIDO, vbInformation + vbOKOnly, ZCOPYRIGHT
cbo_Nombre.SetFocus
Exit Sub
End If
Next
Sheets("Clientes").Activate
Dim fCliente As Integer
fCliente = nCliente(cbo_Nombre.Text)
If fCliente = 0 Then
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate ' si el registro no existe, se va al final.
Loop
Else
Cells(fCliente, 1).Select ' cuando ya existe el registro, cumple esta condición.
End If
'Aqui es cuando agregamos o modificamos el registro
Application.ScreenUpdating = False
ActiveCell = cbo_Nombre
ActiveCell.Offset(0, 1) = txt_Direccion
ActiveCell.Offset(0, 2) = txt_Colonia
ActiveCell.Offset(0, 3) = txt_Ciudad
ActiveCell.Offset(0, 4) = txt_CP
ActiveCell.Offset(0, 5) = txt_Telefono
ActiveCell.Offset(0, 6) = txt_RFC
ActiveCell.Offset(0, 7) = txt_Proveedor
Application.ScreenUpdating = True
LimpiarFormulario
cbo_Nombre.SetFocus
End Sub
Private Sub cmd_Eliminar_Click()
Dim fCliente As Integer
fCliente = nCliente(cbo_Nombre.Text)
If fCliente = 0 Then
MsgBox ZNOEXISTE, vbInformation + vbOKOnly, ZCOPYRIGHT
cbo_Nombre.SetFocus
Exit Sub
End If
If MsgBox(ZELIMINAR, vbQuestion + vbYesNo, ZCOPYRIGHT) = vbYes Then
Cells(fCliente, 1).Select
ActiveCell.EntireRow.Delete
LimpiarFormulario
MsgBox ZELIMINADO, vbInformation + vbOKOnly, ZCOPYRIGHT
cbo_Nombre.SetFocus
End If
End Sub
Private Sub cmd_Cerrar_Click()
End
End Sub
Private Sub cbo_Nombre_Change()
On Error Resume Next
If nCliente(cbo_Nombre.Text) <> 0 Then
Sheets("Clientes").Activate
Cells(cbo_Nombre.ListIndex + 6, 1).Select
txt_Direccion = ActiveCell.Offset(0, 1)
txt_Colonia = ActiveCell.Offset(0, 2)
txt_Ciudad = ActiveCell.Offset(0, 3)
txt_CP = ActiveCell.Offset(0, 4)
txt_Telefono = ActiveCell.Offset(0, 5)
txt_RFC = ActiveCell.Offset(0, 6)
txt_Proveedor = ActiveCell.Offset(0, 7)
Else
txt_Direccion = ""
txt_Colonia = ""
txt_Ciudad = ""
txt_CP = ""
txt_Telefono = ""
txt_RFC = ""
txt_Proveedor = ""
End If
End Sub
Private Sub cbo_Nombre_Enter()
CargarLista
End Sub
Sub CargarLista()
cbo_Nombre.Clear
Sheets("Clientes").Select
Range("A6").Select
Do While Not IsEmpty(ActiveCell)
cbo_Nombre.AddItem ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Sub LimpiarFormulario()
CargarLista
cbo_Nombre = ""
txt_Direccion = ""
txt_Colonia = ""
txt_Ciudad = ""
txt_CP = ""
txt_Telefono = ""
txt_RFC = ""
txt_Proveedor = ""
End Sub
¿Es todo el código?
¿Tienes evento UserForm_Activate o UserForm_Initialize?
nCliente es una función:
fCliente = nCliente(cbo_Nombre.Text)
Puedes poner aquí la función.
-----
NOTA: Para insertar código en el foro, utiliza el icono para insertar código.
Sustituye todo tu código por lo siguiente:
Dim sh As Worksheet ' Private Sub cmd_Agregar_Click() Dim i As Long, lr As Long Dim f As Range ' If cbo_Nombre.Text = "" Then MsgBox ZNOVALIDO, vbInformation + vbOKOnly, ZCOPYRIGHT cbo_Nombre.SetFocus Exit Sub End If If Not (Mid(cbo_Nombre.Text, 1, 1) Like "[a-z]" Or Mid(cbo_Nombre.Text, 1, 1) Like "[A-Z]") Then MsgBox ZNOVALIDO, vbInformation + vbOKOnly, ZCOPYRIGHT cbo_Nombre.SetFocus Exit Sub End If For i = 2 To Len(cbo_Nombre.Text) If Mid(cbo_Nombre.Text, i, 1) Like "#" Then MsgBox ZNOVALIDO, vbInformation + vbOKOnly, ZCOPYRIGHT cbo_Nombre.SetFocus Exit Sub End If Next Set f = sh.Range("A:A").Find(cbo_Nombre.Value, , xlValues, xlWhole, , , False) If f Is Nothing Then lr = sh.Range("A" & Rows.Count).End(3).Row + 1 'cuando no existe Else lr = f.Row ' cuando ya existe el registro End If 'Aqui es cuando agregamos o modificamos el registro sh.Range("A" & lr).Value = cbo_Nombre sh.Range("B" & lr).Value = txt_Direccion sh.Range("C" & lr).Value = txt_Colonia sh.Range("D" & lr).Value = txt_Ciudad sh.Range("E" & lr).Value = txt_CP sh.Range("F" & lr).Value = txt_Telefono sh.Range("G" & lr).Value = txt_RFC sh.Range("H" & lr).Value = txt_Proveedor LimpiarFormulario cbo_Nombre.SetFocus End Sub ' Private Sub cmd_Eliminar_Click() Dim f As Range Set f = sh.Range("A:A").Find(cbo_Nombre.Text, , xlValues, xlWhole, , , False) If f Is Nothing Then MsgBox ZNOEXISTE, vbInformation + vbOKOnly, ZCOPYRIGHT cbo_Nombre.SetFocus Exit Sub End If If MsgBox(ZELIMINAR, vbQuestion + vbYesNo, ZCOPYRIGHT) = vbYes Then f.EntireRow.Delete LimpiarFormulario MsgBox ZELIMINADO, vbInformation + vbOKOnly, ZCOPYRIGHT cbo_Nombre.SetFocus End If End Sub ' Private Sub cmd_Cerrar_Click() End End Sub ' Private Sub cbo_Nombre_Change() Dim lr As Long ' If cbo_Nombre.ListIndex > -1 Then lr = cbo_Nombre.ListIndex + 6 txt_Direccion = sh.Range("B" & lr).Value txt_Colonia = sh.Range("C" & lr).Value txt_Ciudad = sh.Range("D" & lr).Value txt_CP = sh.Range("E" & lr).Value txt_Telefono = sh.Range("F" & lr).Value txt_RFC = sh.Range("G" & lr).Value txt_Proveedor = sh.Range("H" & lr).Value Else txt_Direccion = "" txt_Colonia = "" txt_Ciudad = "" txt_CP = "" txt_Telefono = "" txt_RFC = "" txt_Proveedor = "" End If End Sub ' Private Sub cbo_Nombre_Enter() CargarLista End Sub ' Sub CargarLista() cbo_Nombre.Clear cbo_Nombre.List = sh.Range("A6", sh.Range("A" & Rows.Count).End(3)).Value End Sub ' Sub LimpiarFormulario() CargarLista cbo_Nombre = "" txt_Direccion = "" txt_Colonia = "" txt_Ciudad = "" txt_CP = "" txt_Telefono = "" txt_RFC = "" txt_Proveedor = "" End Sub ' Private Sub UserForm_Activate() Set sh = Sheets("Clientes") End Sub
[Prueba y me comentas...
- Compartir respuesta