Interpretación de código
hola experto, la verdad tengo conocimientos burdos acerca de vba. Puedo una que otra aplicación crear no muy difícil. Hace un tiempo encontré una macro que modificándola un poco me serviría un montón. Pero en partes no entiendo el código, este es así:
Dim Rango As Variant, BD As Worksheet, WK As Worksheet
Private Sub AñadirRegistro_Click()
Dim FILA As Long
If M.ListIndex <> 1 Then
MsgBox "Comando solo disponible en MODO EDICIÓN", vbCritical
Exit Sub
End If
K.Text = xTextBox2
If K.ListIndex <> -1 Then
MsgBox "Ya existe un registro con la misma clave en la base de datos. Corrija y reintente.", vbCritical, "Inserción de registro"
Exit Sub
End If
If IsNumeric(xTextBox2) = False Then
MsgBox "Valor de clave inválido. Corrija y reintente,", vbCritical, "Inserción de registro"
Exit Sub
End If
FILA = BD.Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & FILA) = Range("A" & FILA - 1) + 1
Actualizar FILA
Restaurar_Click
End Sub
Private Sub C_Click()
For Each Control In Controls
If Left(Control.Name, 8) = "xTextBox" Then
Control.BackColor = vbWhite
End If
If Control.Name = C.List(C.ListIndex, 1) Then
Control.BackColor = C.BackColor
Control.SetFocus
Control.SelStart = 0
Control.SelLength = Len(Control.Value)
End If
Next
End Sub
Private Sub CommandButton15_Click()
If L.ListIndex < L.ListCount - 1 Then L.ListIndex = L.ListIndex + 1
End Sub
Private Sub CommandButton18_Click()
MultiPage1.Value = 3
End Sub
Private Sub CommandButton19_Click()
Unload Me
End Sub
Private Sub CommandButton20_Click()
ThisWorkbook.Save
End Sub
Private Sub Actualizar(FILA As Long)
For y = 2 To 16
BD.Cells(FILA, y) = Controls("xTextBox" & y).Value
Next
End Sub
Private Sub CommandButton24_Click()
UserForm2.Show
End Sub
Private Sub CommandButton8_Click()
UserForm2.Show
End Sub
Private Sub EliminarRegistro_Click()
On Error Resume Next
If M.ListIndex <> 1 Then
MsgBox "Comando solo disponible en MODO EDICION", vbCritical
Exit Sub
End If
If L.ListIndex = -1 Then
MsgBox "Elija un elemento de la lista y reintente.", vbCritical, "Eliminación de registro"
Exit Sub
End If
If Val(L.List(L.ListIndex, 1)) <> Val(xTextBox2) Then
MsgBox "La clave no coincide con la del registro seleccionado.", vbCritical, "Eliminación de registro"
Exit Sub
End If
indice = L.ListIndex
BD.Rows(L.ListIndex + 2).Delete
Restaurar_Click
L.ListIndex = indice - 1
End Sub
Private Sub Label37_Click()
UserForm2.Show
End Sub
Private Sub M_Click()
If M.ListIndex = 1 Then Restaurar_Click
End Sub
Private Sub ModificarRegistro_Click()
If M.ListIndex <> 1 Then
MsgBox "Comando solo disponible en MODO EDICION", vbCritical
Exit Sub
End If
If L.ListIndex = -1 Then
MsgBox "Elija un elemento de la lista y reintente.", vbCritical, "Modificación de datos"
Exit Sub
End If
If Val(L.List(L.ListIndex, 1)) <> Val(xTextBox2) Then
MsgBox "La clave no puede modificarse.", vbCritical, "Modificación de datos"
Exit Sub
End If
indice = L.ListIndex
Actualizar L.ListIndex + 2
Restaurar_Click
L.ListIndex = indice
End Sub
Private Sub UserForm_Initialize()
Set BD = Sheets("Hoja1")
Set WK = Sheets("Hoja2")
B.AddItem "Valor exacto"
B.AddItem "Que contenga"
B.AddItem "Que empiece por"
M.AddItem "MODO CONSULTA"
M.AddItem "MODO EDICION"
M.ListIndex = 0
B.ListIndex = 0
For y = 2 To 16
C.AddItem BD.Cells(1, y)
C.List(C.ListCount - 1, 1) = "xTextBox" & y
Controls("xLabel" & y).Caption = BD.Cells(1, y)
Controls("xLabel" & y).TabIndex = y - 2
Next
MultiPage1.Value = 1
Restaurar_Click
MultiPage1.Value = 0
End Sub
Private Sub Restaurar_Click()
L.RowSource = ""
L.ColumnHeads = True
K.Clear
BD.Select
For x = 2 To BD.Range("A" & Rows.Count).End(xlUp).Row
K.AddItem ActiveSheet.Cells(x, 2)
K.List(K.ListCount - 1, 1) = x
Next
Rango = "A1:P" & BD.Range("A" & Rows.Count).End(xlUp).Row
BD.Range(Rango).Copy WK.Range("A1")
WK.Select
L.RowSource = "A2:P" & Range("A" & Rows.Count).End(xlUp).Row
L.ColumnWidths = "50;60"
C.ListIndex = 0
Limpiar_Click
L.Height = 260
BD.Select
xTextBox2.SetFocus
End Sub
Private Sub Limpiar_Click()
For Each Control In Controls
If Left(Control.Name, 8) = "xTextBox" Then
Control.Value = ""
End If
Next
L.ListIndex = -1
End Sub
Private Sub Buscar_Click()
If M.ListIndex = 0 Then
Application.ScreenUpdating = False
L.RowSource = "": K.Clear: L.ColumnHeads = False
WK.Cells.Clear
BD.Rows(1).Copy WK.Rows(1)
Select Case B.ListIndex
Case 0: Texto = Trim(Controls(C.List(C.ListIndex, 1)).Value)
Case 1: Texto = "*" & Trim(Controls(C.List(C.ListIndex, 1)).Value) & "*"
Case 2: Texto = Trim(Controls(C.List(C.ListIndex, 1)).Value) & "*"
End Select
Range("A2").Activate
x = 2
Do Until ActiveCell = ""
If (B.ListIndex = 0 And UCase(ActiveCell.Offset(0, C.ListIndex + 1)) = UCase(Texto)) Or _
(B.ListIndex = 1 And UCase(ActiveCell.Offset(0, C.ListIndex + 1)) Like UCase(Texto)) Or _
(B.ListIndex = 2 And UCase(ActiveCell.Offset(0, C.ListIndex + 1)) Like UCase(Texto)) Then
BD.Rows(ActiveCell.Row).Copy WK.Rows(x)
x = x + 1
End If
ActiveCell.Offset(1, 0).Activate
Loop
If x > 2 Then
WK.Select
L.ColumnHeads = True
L.RowSource = "A2:P" & Range("A" & Rows.Count).End(xlUp).Row
L.ColumnWidths = "50;60"
BD.Select
End If
End If
If M.ListIndex = 1 Then
Application.ScreenUpdating = False
L.RowSource = "": K.Clear: L.ColumnHeads = False
WK.Cells.Clear
BD.Rows(1).Copy WK.Rows(1)
Select Case B.ListIndex
Case 0: Texto = Trim(Controls(C.List(C.ListIndex, 1)).Value)
Case 1: Texto = "*" & Trim(Controls(C.List(C.ListIndex, 1)).Value) & "*"
Case 2: Texto = Trim(Controls(C.List(C.ListIndex, 1)).Value) & "*"
End Select
Range("A2").Activate
x = 2
Do Until ActiveCell = ""
If (B.ListIndex = 0 And UCase(ActiveCell.Offset(0, C.ListIndex + 1)) = UCase(Texto)) Or _
(B.ListIndex = 1 And UCase(ActiveCell.Offset(0, C.ListIndex + 1)) Like UCase(Texto)) Or _
(B.ListIndex = 2 And UCase(ActiveCell.Offset(0, C.ListIndex + 1)) Like UCase(Texto)) Then
BD.Rows(ActiveCell.Row).Copy WK.Rows(x)
x = x + 1
End If
ActiveCell.Offset(1, 0).Activate
Loop
If x > 2 Then
WK.Select
L.ColumnHeads = True
L.RowSource = "A2:P" & Range("A" & Rows.Count).End(xlUp).Row
L.ColumnWidths = "50;60"
BD.Select
End If
End If
End Sub
Private Sub L_Click()
If Saltar = True Then
Saltar = False
Exit Sub
End If
For y = 1 To 15: Controls("xTextBox" & y + 1) =...
1 Respuesta
Creo que sí te puedo ayudar, per tendrás que decirme qué partes no entiendes. Este tipo de código representa siempre un problema, y es que no tiene comentarios. No hace falta comentarlo todo pero al menos algún comentario ayuda a entender las cosas.
Tal vez ir separando cada procedimiento e insertar un comentario sobre lo que hace te ayude a ir entendiendo el código, sobre todo si en el futuro lo tienes que volver a revisar o cambiar.
gracias por aceptarme como discípulo... de verdad muchas gracias !!!!
te paso una parte del código el cual modifica un registro de tipo lineal, osea una fila desde a2:p:2 una serie de datos en cada celda, esto se ve reflejado en un listbox que estoy intentando descifrar je je.. lo curioso de esto es que no modifica en la celda original, sino que crea una nevá (como un especie de insertar fila i carga los datos nuevos allí), para mi esto es tipo brujería je je por que usualmente lo hago esto de insertar filas y grabar los datos de algunos textbox pero de otra forma y con este código no se cual es la magia al respecto..
el código es el siguiente:
Private Sub ModificarRegistro_Click()
If M.ListIndex <> 1 Then
MsgBox "Comando solo disponible en MODO EDICIÓN", vbCritical
Exit Sub
End If
If L.ListIndex = -1 Then
MsgBox "Elija un elemento de la lista y reintente.", vbCritical, "Modificación de datos"
Exit Sub
End If
If Val(L.List(L.ListIndex, 1)) <> Val(xTextBox2) Then
MsgBox "La clave no puede modificarse.", vbCritical, "Modificación de datos"
Exit Sub
End If
indice = L.ListIndex
Actualizar L.ListIndex + 5
Restaurar_Click
L.ListIndex = indice
End Sub
muchas gracias por tu ayuda y la voluntad de colaborar conmigo !!!
desde tierra del fuego argentina un gran abrazo...
este otro código que expongo es para añadir un registro
Private Sub AñadirRegistro_Click()
Dim FILA As Long
If M.ListIndex <> 1 Then
MsgBox "Comando solo disponible en MODO EDICIÓN", vbCritical
Exit Sub
End If
K.Text = xTextBox2
If K.ListIndex <> -1 Then
MsgBox "Ya existe un registro con la misma clave en la base de datos. Corrija y reintente.",
vbCritical, "Inserción de registro"
Exit Sub
End If
If IsNumeric(xTextBox2) = False Then
MsgBox "Valor de clave inválido. Corrija y reintente,", vbCritical, "Inserción de registro"
Exit Sub
End If
FILA = BD.Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & FILA) = Range("A" & FILA - 1) + 1
Actualizar FILA
Restaurar_Click
End Sub
este es el código que hace que se agreguen los registros, a mi forma de pensar no es muy diferente al anterior solo existen cosas que no entiendo aún como lo son las partes subrayadas
y que aplicaciones o usos se le dan a por ejemplo: .listindex?..... o que significa <>?
si quieres que te envíe el archivo para ayudarme mejor me lo pides, mi correo es [email protected]
gracias por vuestra preciada ayuda !!!!
Vamos por partes para intentar hacer las cosas bien desde el principio.
Lo primero en el inicio del código escribe
Option Explicit
Esto hace que todas las variables se deban declarar antes de poder ser usadas y evita errores cuando nos equivocamos en el nombre de una variable. Si es como parece, al incluir esta opción provocará errores sintácticos en el código. Te aparecerá marcada en amarillo la variable que no ha sido declarada. Entonces tendrás que declararla en la cabecera del programa (si es global, y es lo menos recomendable) o dentro del procedimiento o función (local y más recomendable).
En el primer caso M y L, así como índice no están declarados. Ese procedimiento solo hace unas comprobaciones y luego llama a Actualizar y Restaurar_Click que supongo que son los procedimientos que realmente hacen algo si las comprobaciones son correctas.
En la segunda parte hace algo similar pero pasando la variable FILA, que supongo debe ser un entero. Fila cuenta las filas desde A hacia arriba y añade 1 y supongo que BD es una hoja. Este código puede dar lugar a error si la hoja activa no es una concreta, puesto que Rows. Count por defecto es de la hoja activa.
FILA = BD.Range("A" & Rows.Count).End(xlUp).Row +1Los signos <> que aparecen son solo del código HTML, de la página de donde lo has copiado. Debe ser solo un error de copy/paste. En VBA < y > se usan en las comparaciones como menor que y mayor que. En cuanto a listindex es una propiedad de un control de lista que indica que elemento se selecciónó.
muchas gracias por tu ayuda ya lo voy entendiendo mejor, en unos minutos que envío un diagramita para que veas y me comentes algo
De acuerdo. Pero si vas a tardar te pediría que cierres y valores la respuesta y más adelante abras una nueva.
muchas gracias por todo mañana sin falta lo hago... me tome el finde largo y donde fui no había internet... muchas gracias un abrazo desde el fin del mundo !!!
