Macro para modificar registros del combobox
Para dante
Buen día
Podrías ayudarme con esto
Tengo un archivo que ya me has trabajado, con el cual ingreso a través de formulario datos y que utiliza un combobox con lista, pero me doy cuenta que los datos del combobox no se pueden modificar, solo los demás datos que corresponden al nombre que aparece en el combo. Para modificar el dato del combo tengo que volver a ingresar el dato y eliminar el que esta mal.
Te mando el archivo
1 Respuesta
Respuesta de Dante Amor
1
¡Gracias!
pregunta cancelada, voy a reformular la pregunta y explicarla mejor
saludos
Te anexo todo el código para que verifiques todos los cambios que le hice:
'Option Explicit
Dim ArchivoIMG As String
'
Private Sub cmd_Agregar_Click()
'Por.Dante Amor
'
If Not UCase(Left(TextBox1, 1)) Like "[A-Z]" Then
MsgBox "Nombre inválido", vbInformation + vbOKOnly
TextBox1.SetFocus
Exit Sub
End If
'
If OptionButton1.Value = False And OptionButton2.Value = False And OptionButton3.Value = False And OptionButton4.Value = False And OptionButton5.Value = False Then
MsgBox "Debes seleccionar algún botón de Cliente. Luego ejecuta nuevamente el botón de guardado.", , "ERROR"
Exit Sub
End If
'
If OptionButton6 = False And OptionButton7 = False Then
MsgBox "Selecciona la opción de agregar o modificar"
Exit Sub
End If
'
If TextBox1 = "" Then
MsgBox "Escribe el nuevo nombre"
TextBox1.SetFocus
Exit Sub
End If
'
If OptionButton6 Then 'Agregar registro
Set b = Columns("A").Find(TextBox1, lookat:=xlWhole)
If Not b Is Nothing Then
MsgBox "El nombre ya existe"
TextBox1.SetFocus
End If
Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Select
ElseIf OptionButton7 Then ' modificar
If cbo_Nombre.ListIndex = -1 Then
MsgBox "Para modificar un nombre, primero tienes que seleccionar uno"
cbo_Nombre.SetFocus
Exit Sub
End If
End If
'Aqui es cuando agregamos o modificamos el registro
ActiveCell = TextBox1
ActiveCell.Offset(0, 1) = txt_numero
ActiveCell.Offset(0, 2) = txt_conteofisico
ActiveCell.Offset(0, 3) = txt_fechaven
ActiveCell.Offset(0, 4) = txt_numerolote
ActiveCell.Offset(0, 5) = txt_nukardex
ActiveCell.Offset(0, 6) = txt_fekardex
ActiveCell.Offset(0, 7) = txt_ultimosaldo
ActiveCell.Offset(0, 8) = txt_observaciones
ActiveCell.Offset(0, 9) = ArchivoIMG
'
Columns("J").EntireColumn.Hidden = True
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A1")
.SetRange Range("A2:J" & Range("A" & Rows.Count).End(xlUp).Row)
.Header = xlNo: .MatchCase = False: .Orientation = xlTopToBottom
.SortMethod = xlPinYin: .Apply
End With
'
LimpiarFormulario
OptionButton6 = False: OptionButton7 = False
cbo_Nombre.SetFocus
End Sub
Private Sub cmd_Eliminar_Click()
Dim fCliente As Integer
fCliente = nCliente(cbo_Nombre.Text)
If fCliente = 0 Then
MsgBox "El cliente que usted quiere eliminar no existe", vbInformation + vbOKOnly
cbo_Nombre.SetFocus
Exit Sub
End If
If MsgBox("¿Seguro que quiere eliminar este cliente?", vbQuestion + vbYesNo) = vbYes Then
Cells(fCliente, 1).Select
ActiveCell.EntireRow.Delete
LimpiarFormulario
MsgBox "Cliente eliminado", vbInformation + vbOKOnly
cbo_Nombre.SetFocus
End If
End Sub
Private Sub cmd_Cerrar_Click()
Application.ScreenUpdating = True
Call Ocultas
ActiveWorkbook.Save
frm_Clientes.Hide
ThisWorkbook.Application.Visible = False
OptionButton1.Value = False
OptionButton2.Value = False
OptionButton3.Value = False
OptionButton4.Value = False
OptionButton5.Value = False
Load Menu
Menu.Show
End Sub
Private Sub cbo_Nombre_Change()
'On Error Resume Next
If cbo_Nombre.ListIndex > -1 Then
Cells(cbo_Nombre.ListIndex + 2, 1).Select
txt_numero = ActiveCell.Offset(0, 1)
txt_conteofisico = ActiveCell.Offset(0, 2)
txt_fechaven = ActiveCell.Offset(0, 3)
txt_numerolote = ActiveCell.Offset(0, 4)
txt_nukardex = ActiveCell.Offset(0, 5)
txt_fekardex = ActiveCell.Offset(0, 6)
txt_ultimosaldo = ActiveCell.Offset(0, 7)
txt_observaciones = ActiveCell.Offset(0, 8)
On Error Resume Next
fotografia.Picture = LoadPicture("")
fotografia.Picture = LoadPicture(ActiveCell.Offset(0, 9))
ArchivoIMG = ActiveCell.Offset(0, 9)
On Error GoTo 0
Else
'TextBox1 = ""
txt_numero = ""
txt_conteofisico = ""
txt_fechaven = ""
txt_numerolote = ""
txt_nukardex = ""
txt_fekardex = ""
txt_ultimosaldo = ""
txt_observaciones = ""
ArchivoIMG = ""
fotografia.Picture = LoadPicture("")
End If
End Sub
'
Sub CargarLista()
cbo_Nombre.Clear
Range("A2").Select
Do While Not IsEmpty(ActiveCell)
cbo_Nombre.AddItem ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop
End Sub
'
Sub LimpiarFormulario()
CargarLista
cbo_Nombre = ""
TextBox1 = ""
txt_numero = ""
txt_conteofisico = ""
txt_fechaven = ""
txt_numerolote = ""
txt_nukardex = ""
txt_fekardex = ""
txt_ultimosaldo = ""
txt_observaciones = ""
ArchivoIMG = ""
End Sub
Private Sub cmd_Imagen_Click()
On Error Resume Next
ArchivoIMG = Application.GetOpenFilename("Imágenes jpg,*.jpg,Imágenes bmp,*.bmp", 0, "Seleccionar Imágen para Reegistro de Clientes")
fotografia.Picture = LoadPicture("")
fotografia.Picture = LoadPicture(ArchivoIMG)
End Sub
Private Sub commandbutton1_click()
ActiveWindow.SelectedSheets.PrintOut Copies:=1
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Documents and Settings\MORALES\Escritorio\Inventario\" + Cells(2, 12) & Format(Cells(2, 13), "dd-mm-yyyy") & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End Sub
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Cells.EntireRow.Hidden = False
Dim Celda As Range
For Each Celda In Range(Range("c2"), Range("c65536").End(xlUp))
If Celda <> 0 Then Celda.EntireRow.Hidden = False Else Celda.EntireRow.Hidden = True
Next
End Sub
Private Sub OptionButton1_Click() 'repetir para cada OB
If OptionButton1.Value = True Then
Sheets("Medicamentos").Select
Call CargarLista
cbo_Nombre.SetFocus
End If
End Sub
Private Sub OptionButton2_Click() 'repetir para cada OB
If OptionButton2.Value = True Then
Sheets("Planificacion F.").Select
Call CargarLista
cbo_Nombre.SetFocus
End If
End Sub
Private Sub OptionButton3_Click() 'repetir para cada OB
If OptionButton3.Value = True Then
Sheets("Quirurgico").Select
Call CargarLista
cbo_Nombre.SetFocus
End If
End Sub
Private Sub OptionButton4_Click() 'repetir para cada OB
If OptionButton4.Value = True Then
Sheets("M. de Oficina").Select
Call CargarLista
cbo_Nombre.SetFocus
End If
End Sub
Private Sub OptionButton5_Click() 'repetir para cada OB
If OptionButton5.Value = True Then
Sheets("M. de Limpieza").Select
Call CargarLista
cbo_Nombre.SetFocus
End If
End Sub
'
Private Sub txt_fechaven_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal shift As Integer)
Select Case Len(txt_fechaven.Value)
Case 2
txt_fechaven.Value = txt_fechaven.Value & "/"
Case 5
txt_fechaven.Value = txt_fechaven.Value & "/"
End Select
End Sub
Private Sub txt_fekardex_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal shift As Integer)
Select Case Len(txt_fekardex.Value)
Case 2
txt_fekardex.Value = txt_fekardex.Value & "/"
Case 5
txt_fekardex.Value = txt_fekardex.Value & "/"
End Select
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
' If CloseMode = vbFormControlMenu Then
' Cancel = True
' End If
End Sub
Sub Ocultas()
Rows.EntireRow.Hidden = False
End SubNo olvides cambiar la valoración a la respuesta.
