Crear alerta de vencimientos en excel.

Pues bien, estoy creando en excel un pequeño sistema para realizar apartados en una tienda pequeña, que asigna fechas de pagos, montos de pagos mínimos y vencimientos en caso de no realizar los pagos correspondientes, en una de las hojas de tengo un cuadro en el cual hay condicionadas ciertas celdas que muestran los siguientes textos:

Si el apartado esta en tiempo dice "al corriente", si el apartado esta en su ultimo día de pago dice "ultimo día de pago", si el apartado tiene vencidos 2 pagos la celda muestra "sacar a la venta".

Lo que me gustaría hacer es que excel mostrara un cuadro de dialogo que indicara si existen apartados en su ultimo día de pago, y, si hay apartados que ya estén vencidos. Algo como

"el día de hoy vencen "X" apartados, y hay "X" apartados que se deben sacar a venta".

Esto para que el usuario vaya a dicha hoja de excel y pueda verificar cuales son los vencimientos y los vencidos, sin necesidad de estar revisando diariamente esta hoja.

No necesito que muestre el texto basado en una fecha, sino, en el texto que muestran las celdas que ya tengo condicionadas.

1 respuesta

Respuesta
1

Te anexo la macro, se ejecuta en automático cuando abres el libro, para eso deberás poner la macro en los eventos de workbook, cambia en la macro "Hoja1" por el nombre de la hoja en donde quieras hacer la búsqueda.

Private Sub Workbook_Open()
'Por.Dante Amor
    Set h = Sheets("Hoja1")
    Set r = h.Cells
    Set b = r.Find("ultimo día de pago", lookat:=xlWhole)
    If Not b Is Nothing Then
        ncell = b.Address
        Do
            cad1 = cad1 & b.Address(False, False) & " "
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> ncell
    End If
    '
    Set b = r.Find("sacar a la venta", lookat:=xlWhole)
    If Not b Is Nothing Then
        ncell = b.Address
        Do
            cad2 = cad2 & b.Address(False, False) & " "
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> ncell
    End If
    '
    If cad1 <> "" Then
        cad3 = "El día de hoy vencen: " & cad1 & "apartados."
    End If
    If cad2 <> "" Then
        If cad3 <> "" Then
            cad3 = cad3 & " " & " y hay " & cad2 & " apartados que se deben sacar a venta"
        Else
            cad3 = "Hay " & cad2 & " apartados que se deben sacar a venta"
        End If
    End If
    MsgBox cad3
End Sub

Instrucciones para poner la macro en los eventos ThisWorkbook

  1. Abre tu libro de excel
  2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
  3. Del lado izquierdo dice: VBAProject, abajo dale doble click a ThisWorkbook
  4. Del lado derecho copia la macro

Saludos. Dante Amor

No olvides valorar la respuesta.

Wooo!

Excelente respuesta amigo, solo que el cuadro de dialogo que me arroja al abrir el libro aparece en blanco, no muestra nada

Significa que no hay apartados que venzan o que haya que sacar a la venta.

Para que no te aparezca la ventana, cambia la macro por esta:

Private Sub Workbook_Open()
'Por.Dante Amor
    Set h = Sheets("Hoja1")
    Set r = h.Cells
    Set b = r.Find("ultimo día de pago", LookAt:=xlWhole)
    If Not b Is Nothing Then
        ncell = b.Address
        Do
            cad1 = cad1 & b.Address(False, False) & " "
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> ncell
    End If
    '
    Set b = r.Find("sacar a la venta", LookIn:=xlFormulas, LookAt:=xlWhole, MatchCase:=False)
    If Not b Is Nothing Then
        ncell = b.Address
        Do
            cad2 = cad2 & b.Address(False, False) & " "
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> ncell
    End If
    '
    If cad1 <> "" Then
        cad3 = "El día de hoy vencen: " & cad1 & "apartados."
    End If
    If cad2 <> "" Then
        If cad3 <> "" Then
            cad3 = cad3 & " " & " y hay " & cad2 & " apartados que se deben sacar a venta"
        Else
            cad3 = "Hay " & cad2 & " apartados que se deben sacar a venta"
        End If
    End If
    If cad3 <> "" Then MsgBox cad3
End Sub

Revisa en la macro que los mensajes estén escritos como requieras. Yo puse esto:

"último día de pago"

"sacar a la venta"

No importan las mayúsculas, pero sí los acentos y los espacios.

Corrige en la macro los textos correctos y vuelve a probar.


Agradezco el tiempo que tomas en contestarme.

En la imagen que subí, puedes ver que una línea de celdas están rojas, eso es porque coloque un apartado que al día de hoy esta vencido solo para ver que funcionara, ya revise los textos de las fórmulas, y los cambie por los textos correctos.

También probé con todos los apartados al corriente, no muestra ninguna ventana, pero en el caso de un vencido o un "ultimo día" si muestra el cuadro, solo que vació.

Prueba con la última macro que te envié.

Revisa que los textos de la macro, coincidan exactamente con lo que tienes en tu hoja.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas