Edición de macro para poder editar datos finales de una o otra página
Espero estés bien, animo, salud y felis
Vengo con el ultimo detalle en la plantilla Lista Repuestos y es que no puedo editar de una o otra página.
El caso es que relleno los controles para la edición de Datos finales y después de corrigir o enmendar algo de la página 1, piso button Insertar y resulta que me envía los datos hacia la página 2.
En la propia hoja tengo la indicación.
Si me permites te enviaría la plantilla
Te deseo lo mejor
1 respuesta
Respuesta de Dante Amor
1
Ya te lo envíe Dante, gracias por atenderme
Ahí te van todas las macros actualizadas
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
'
Private Sub CheckBox1_Click()
'Por Dante amor http://www.todoexpertos.com/preguntas/6gjby9n8rtox64wr/centrar-formulario-excel-en-pantalla
Dim i
If CheckBox1 Then
CheckBox2.Value = False
ComboBox1 = ""
ComboBox1.Visible = False 'Agregado nuevo
frmLista.Height = 192
frmLista.StartUpPosition = 2 'CENTRAR EL FORMULARIO
frmLista.Show
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.Top = 155: CheckBox2.Left = 354
CheckBox3.Visible = False
Next
For i = 7 To 12
Controls("TextBox" & i).Visible = True
DTPicker1.Top = 18
DTPicker1.Visible = True
Controls("Label" & i).Visible = True
Controls("Label" & i).Top = 6
Controls("TextBox" & i).Top = 18
TextBox12.Top = 71: Label12.Top = 53: Label13.Top = 53
Label12.Visible = True: Label13.Visible = True
Next
CheckBox1.Caption = "DESmarca para insertar productos"
Else
frmLista.Height = 120
frmLista.StartUpPosition = 2
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
Next
For i = 7 To 12
Controls("TextBox" & i).Visible = False
DTPicker1.Visible = False
'Controls("TextBox" & i) = ""
Controls("Label" & i).Visible = False
Label13.Visible = False
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("O8") '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 cmbCerrar_Click()
Unload Me
End Sub
Private Sub cmbInsertar_Click()
'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, i, LastRow, u
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 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 #
'
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 = 12 Else n = 19 '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 > 19 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 = 12 Else n = 19 'original es 10 17 Se puede jugar con estos números
If u > 19 Then ActiveWindow.ScrollRow = u - n 'Original 17
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 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 TextBox3_Change()
TextBox3.Text = UCase(TextBox3.Text)
End Sub
Private Sub TextBox5_Change()
TextBox5.Text = UCase(TextBox5.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", "TextBox10", "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
End Sub 'Fin cargar textboxsal u dos
