Anónimo
Problema con esta macro
Amigo experto de nuevo yo otra vez Tengo la siguiente macro la cual me recorre la columna E desde la fila 5 hasta donde halla dato y me copara la fecha guardada en esta columnaE con la fea(date) del sistema menos quince días ya que esto es para que me genere un mensaje de alerta cuando falten 15 días para vencerse la licencia de cada Expendedor(Cliente) y que a la ves me coloque la celda donde se cumpla esta condición en amarillo, en el final del código mando a ejecutar esta macro que tengo en un modulo cada cuatro horas,
ok
hasta aquí esto funciona muy bien
El problema que se me esta presentando es que cuando la macro se ejecute y seleccione la celda que cumpla con la condición dada, coloque en amarillo toda esa fila desde la columna hasta la columnaK me emita el mensaje informativo y luego me cargue todos los datos de esa fila en un "ListBox1" el cual se haga visible en pantalla de manera que el usuario sepa con detalles a quien le queda pocos días para vencercele la licencia.
Como la macro se seguirá ejecutando cada 4 horas después de prender el ordenador al encontrase con otra celda que cumpla con la condición dada; y si esta en color amarillo la salte realice el mismo procedimiento y muestre solamente el mesaje informativo de la celda o celdas que encontró nuevamente y no me emita el mensaje informativo de todas las celdas que están en amarillo encontradas en ejecuciones pasadas y a la vez me muestre la caja de lista con todos los datos que estén en todas las filas marcadas en amariillo y así sucesivamente.
Este es el código
Option Explicit
Sub CTRLVENCIMIENTO()
Dim filas As Double
Dim fecha As Date
Dim i As Double
Sheets("Hoja4").Select
Range("E5").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
filas = ActiveCell.Row - 1
For i = 5 To filas
fecha = Cells(i, 5).Value
If fecha = Date - 15 Then
Cells(i, 5).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
MsgBox ("Falttan Quince Dias Para Vencerse por lo Menos una Licencia, EXPENDEDOR"), vbDefaultButton4
End If
Next
Application.OnTime Now + TimeValue("4:00:00"), "CTRLVENCIMIENTO"
End Sub
ok
hasta aquí esto funciona muy bien
El problema que se me esta presentando es que cuando la macro se ejecute y seleccione la celda que cumpla con la condición dada, coloque en amarillo toda esa fila desde la columna hasta la columnaK me emita el mensaje informativo y luego me cargue todos los datos de esa fila en un "ListBox1" el cual se haga visible en pantalla de manera que el usuario sepa con detalles a quien le queda pocos días para vencercele la licencia.
Como la macro se seguirá ejecutando cada 4 horas después de prender el ordenador al encontrase con otra celda que cumpla con la condición dada; y si esta en color amarillo la salte realice el mismo procedimiento y muestre solamente el mesaje informativo de la celda o celdas que encontró nuevamente y no me emita el mensaje informativo de todas las celdas que están en amarillo encontradas en ejecuciones pasadas y a la vez me muestre la caja de lista con todos los datos que estén en todas las filas marcadas en amariillo y así sucesivamente.
Este es el código
Option Explicit
Sub CTRLVENCIMIENTO()
Dim filas As Double
Dim fecha As Date
Dim i As Double
Sheets("Hoja4").Select
Range("E5").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
filas = ActiveCell.Row - 1
For i = 5 To filas
fecha = Cells(i, 5).Value
If fecha = Date - 15 Then
Cells(i, 5).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
MsgBox ("Falttan Quince Dias Para Vencerse por lo Menos una Licencia, EXPENDEDOR"), vbDefaultButton4
End If
Next
Application.OnTime Now + TimeValue("4:00:00"), "CTRLVENCIMIENTO"
End Sub
1 respuesta
Respuesta de edwinhenao
1
Debes hacer modificaciones para incluir las demás columnas a colorear, también hay que preguntar por el color para que la celda que ya está coloreada no sea agregada. Por otro lado hay que realizar un control de errores para controlar el ListBox y que éste solo sea agregado una sola vez. Se me ocurre algo como esto...
...
Sub CTRLVENCIMIENTO()
Dim filas As Double
Dim fecha As Date
Dim i As Double
Dim Celda As Range
On Error GoTo ControlErrores
Sheets("Hoja4").Shapes("ElCuadro").Select
Sheets("Hoja4").Select
Range("E5").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
filas = ActiveCell.Row - 1
For i = 5 To filas
fecha = Cells(i, 5).Value
ElColor = Cells(i, 5).Interior.ColorIndex
If (fecha = (Date - 15)) And (ElColor <> 6) Then
Range(Cells(i, 1), Cells(i, 11)).Select
ElRango = Selection.Address
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
For Each Celda In Selection
Sheets("Hoja4").Shapes("ElCuadro").ControlFormat.AddItem Celda.Value
Next Celda
MsgBox ("Faltan Quince Dias Para Vencerse por lo Menos una Licencia, EXPENDEDOR"), vbDefaultButton4
End If
Next
Application.OnTime Now + TimeValue("4:00:00"), "CTRLVENCIMIENTO"
Exit Sub
ControlErrores:
Set lb = Sheets("Hoja4").Shapes.AddFormControl(xlListBox, 100, 10, 100, 100)
lb.Select
Selection.Name = "ElCuadro"
Sheets("Hoja4").Select
Range("E5").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
filas = ActiveCell.Row - 1
For i = 5 To filas
fecha = Cells(i, 5).Value
ElColor = Cells(i, 5).Interior.ColorIndex
If (fecha = (Date - 15)) And (ElColor <> 6) Then
Range(Cells(i, 1), Cells(i, 11)).Select
ElRango = Selection.Address
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
For Each Celda In Selection
lb.ControlFormat.AddItem Celda.Value
Next Celda
MsgBox ("Faltan Quince Dias Para Vencerse por lo Menos una Licencia, EXPENDEDOR"), vbDefaultButton4
End If
Next
Application.OnTime Now + TimeValue("4:00:00"), "CTRLVENCIMIENTO"
End Sub
...
Sub CTRLVENCIMIENTO()
Dim filas As Double
Dim fecha As Date
Dim i As Double
Dim Celda As Range
On Error GoTo ControlErrores
Sheets("Hoja4").Shapes("ElCuadro").Select
Sheets("Hoja4").Select
Range("E5").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
filas = ActiveCell.Row - 1
For i = 5 To filas
fecha = Cells(i, 5).Value
ElColor = Cells(i, 5).Interior.ColorIndex
If (fecha = (Date - 15)) And (ElColor <> 6) Then
Range(Cells(i, 1), Cells(i, 11)).Select
ElRango = Selection.Address
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
For Each Celda In Selection
Sheets("Hoja4").Shapes("ElCuadro").ControlFormat.AddItem Celda.Value
Next Celda
MsgBox ("Faltan Quince Dias Para Vencerse por lo Menos una Licencia, EXPENDEDOR"), vbDefaultButton4
End If
Next
Application.OnTime Now + TimeValue("4:00:00"), "CTRLVENCIMIENTO"
Exit Sub
ControlErrores:
Set lb = Sheets("Hoja4").Shapes.AddFormControl(xlListBox, 100, 10, 100, 100)
lb.Select
Selection.Name = "ElCuadro"
Sheets("Hoja4").Select
Range("E5").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
filas = ActiveCell.Row - 1
For i = 5 To filas
fecha = Cells(i, 5).Value
ElColor = Cells(i, 5).Interior.ColorIndex
If (fecha = (Date - 15)) And (ElColor <> 6) Then
Range(Cells(i, 1), Cells(i, 11)).Select
ElRango = Selection.Address
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
For Each Celda In Selection
lb.ControlFormat.AddItem Celda.Value
Next Celda
MsgBox ("Faltan Quince Dias Para Vencerse por lo Menos una Licencia, EXPENDEDOR"), vbDefaultButton4
End If
Next
Application.OnTime Now + TimeValue("4:00:00"), "CTRLVENCIMIENTO"
End Sub
Amigo experto probé con el código que me enviaste
lo que quiero saber es lo siguiente:
Declare algunas variables como lo puedes ver en el código, ! Pero no se¡, a la variable ElColor ¿esta bien que la declare tipo String?, al igual que a la variable ElRango esto es lo que quiero saber es relación a esto
por otra parte declare también la variable lb de tipo objet para que el código que me enviaste funcionara de hecho funciona pero con algunos problemitas, te explico: los datos me aparecen en una sola columna y quisiera que me aparecieran en varias columnas, esta es la forma que me aparece
maría (Nombre)
García (apellido)
Villa Rosa (esta es la Dirección)
09/02/2001
Esto es el ejemplo de la forma como me aparece
Quisiera que me que dará de la siguiente manera:
maria garcia villa rosa 09/02/2011
tambiem se me esta presentando otro probema que al ejecutar la macro el lb queda como estatico en la hoja y no hallo como moverlo o quitarlo,pues tengo que recurrir a cortarlo o eliminarlo para poderlo quitar, lo que quisiera saber es como hago para que el lb que aprezca con los datos sea dinamico es decir que aparezca con los datos y tenga un boton que diga ACEPTAR y que al yo hacer clik se desaparezca y asi sucesivamente
tambien quiero que me expliques a que hace referencia esa palabra que aprece en el codigo que me envias es decir ("ElCuadro")que esta en la linea de codigo Sheets("Hoja4").Shapes("ElCuadro").Selec lo que pasa que no lo endiendo y qeisiera saber que significa para aprender
tambien se me esta presentando otro problemita que ejecutar la macro y querer cerrar el libro me aparece un mesaje de windows que me dice que se produjo un error, y me pregunta que si lo voy a enviar o no lo voy a enviar y al decir que no no me realiza la aplicacion de guardar los cambios realizados en el libro.
Me disculpas tantas preguntas lo que pasa es que estoy aprendiendo a manejar esta aplicación
Option Explicit
Sub CTRLVENCIMIENTO()
Dim filas As Double
Dim fecha As Date
Dim i As Double
Dim Celda As Range
Dim ElColor As String
Dim ElRango As String
Dim lb As Object
On Error GoTo ControlErrores
Sheets("Hoja4").Shapes("ElCuadro").Select
Sheets("Hoja4").Select
Range("E5").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
filas = ActiveCell.Row - 1
For i = 5 To filas
fecha = Cells(i, 5).Value
ElColor = Cells(i, 5).Interior.ColorIndex
If (fecha = (Date - 15)) And (ElColor <> 6) Then
Range(Cells(i, 1), Cells(i, 11)).Select
ElRango = Selection.Address
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
For Each Celda In Selection
Sheets("Hoja4").Shapes("ElCuadro").ControlFormat.AddItem Celda.Value
Next Celda
MsgBox ("Faltan Quince Dias Para Vencerse por lo Menos una Licencia, EXPENDEDOR"), vbDefaultButton4
End If
Next
Application.OnTime Now + TimeValue("4:00:00"), "CTRLVENCIMIENTO"
Exit Sub
ControlErrores:
Set lb = Sheets("Hoja4").Shapes.AddFormControl(xlListBox, 100, 10, 100, 100)
lb.Select
Selection.Name = "ElCuadro"
Sheets("Hoja4").Select
Range("E5").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
filas = ActiveCell.Row - 1
For i = 5 To filas
fecha = Cells(i, 5).Value
ElColor = Cells(i, 5).Interior.ColorIndex
If (fecha = (Date - 15)) And (ElColor <> 6) Then
Range(Cells(i, 1), Cells(i, 11)).Select
ElRango = Selection.Address
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
For Each Celda In Selection
lb.ControlFormat.AddItem Celda.Value
Next Celda
MsgBox ("Faltan Quince Dias Para Vencerse por lo Menos una Licencia, EXPENDEDOR"), vbDefaultButton4
End If
Next
Application.OnTime Now + TimeValue("4:00:00"), "CTRLVENCIMIENTO"
End Sub
lo que quiero saber es lo siguiente:
Declare algunas variables como lo puedes ver en el código, ! Pero no se¡, a la variable ElColor ¿esta bien que la declare tipo String?, al igual que a la variable ElRango esto es lo que quiero saber es relación a esto
por otra parte declare también la variable lb de tipo objet para que el código que me enviaste funcionara de hecho funciona pero con algunos problemitas, te explico: los datos me aparecen en una sola columna y quisiera que me aparecieran en varias columnas, esta es la forma que me aparece
maría (Nombre)
García (apellido)
Villa Rosa (esta es la Dirección)
09/02/2001
Esto es el ejemplo de la forma como me aparece
Quisiera que me que dará de la siguiente manera:
maria garcia villa rosa 09/02/2011
tambiem se me esta presentando otro probema que al ejecutar la macro el lb queda como estatico en la hoja y no hallo como moverlo o quitarlo,pues tengo que recurrir a cortarlo o eliminarlo para poderlo quitar, lo que quisiera saber es como hago para que el lb que aprezca con los datos sea dinamico es decir que aparezca con los datos y tenga un boton que diga ACEPTAR y que al yo hacer clik se desaparezca y asi sucesivamente
tambien quiero que me expliques a que hace referencia esa palabra que aprece en el codigo que me envias es decir ("ElCuadro")que esta en la linea de codigo Sheets("Hoja4").Shapes("ElCuadro").Selec lo que pasa que no lo endiendo y qeisiera saber que significa para aprender
tambien se me esta presentando otro problemita que ejecutar la macro y querer cerrar el libro me aparece un mesaje de windows que me dice que se produjo un error, y me pregunta que si lo voy a enviar o no lo voy a enviar y al decir que no no me realiza la aplicacion de guardar los cambios realizados en el libro.
Me disculpas tantas preguntas lo que pasa es que estoy aprendiendo a manejar esta aplicación
Option Explicit
Sub CTRLVENCIMIENTO()
Dim filas As Double
Dim fecha As Date
Dim i As Double
Dim Celda As Range
Dim ElColor As String
Dim ElRango As String
Dim lb As Object
On Error GoTo ControlErrores
Sheets("Hoja4").Shapes("ElCuadro").Select
Sheets("Hoja4").Select
Range("E5").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
filas = ActiveCell.Row - 1
For i = 5 To filas
fecha = Cells(i, 5).Value
ElColor = Cells(i, 5).Interior.ColorIndex
If (fecha = (Date - 15)) And (ElColor <> 6) Then
Range(Cells(i, 1), Cells(i, 11)).Select
ElRango = Selection.Address
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
For Each Celda In Selection
Sheets("Hoja4").Shapes("ElCuadro").ControlFormat.AddItem Celda.Value
Next Celda
MsgBox ("Faltan Quince Dias Para Vencerse por lo Menos una Licencia, EXPENDEDOR"), vbDefaultButton4
End If
Next
Application.OnTime Now + TimeValue("4:00:00"), "CTRLVENCIMIENTO"
Exit Sub
ControlErrores:
Set lb = Sheets("Hoja4").Shapes.AddFormControl(xlListBox, 100, 10, 100, 100)
lb.Select
Selection.Name = "ElCuadro"
Sheets("Hoja4").Select
Range("E5").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
filas = ActiveCell.Row - 1
For i = 5 To filas
fecha = Cells(i, 5).Value
ElColor = Cells(i, 5).Interior.ColorIndex
If (fecha = (Date - 15)) And (ElColor <> 6) Then
Range(Cells(i, 1), Cells(i, 11)).Select
ElRango = Selection.Address
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
For Each Celda In Selection
lb.ControlFormat.AddItem Celda.Value
Next Celda
MsgBox ("Faltan Quince Dias Para Vencerse por lo Menos una Licencia, EXPENDEDOR"), vbDefaultButton4
End If
Next
Application.OnTime Now + TimeValue("4:00:00"), "CTRLVENCIMIENTO"
End Sub
Declarar todas las variables es una buena práctica, pero a veces complica las cosas, si no quieres declarar todas las variables quita la línea Option Explicit.
La variable color funcionaría mejor con Integer, la variable ElRango sería mejor declararla como Range, lb está bien como Object.
ElCuadro es el nombre que se le da al listBox para luego poder manejarlo desde VBA. Si lo quieres seleccionar en Excel, tienes que ir a la ficha programador y en el grupo Controles activar el Modo Diseño.
Para lo que describes te recomiendo entonces que uses el ListBox en un UserForm y cambies el ColumnCount del ListBox a 11.
Éxitos.
La variable color funcionaría mejor con Integer, la variable ElRango sería mejor declararla como Range, lb está bien como Object.
ElCuadro es el nombre que se le da al listBox para luego poder manejarlo desde VBA. Si lo quieres seleccionar en Excel, tienes que ir a la ficha programador y en el grupo Controles activar el Modo Diseño.
Para lo que describes te recomiendo entonces que uses el ListBox en un UserForm y cambies el ColumnCount del ListBox a 11.
Éxitos.