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?

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
