Los datos expuestos en este blog, son solo de índole informativo. Por favor realiza siempre una copia de seguridad antes de realizar cualquier cambio en tu proyecto.
MS Excel 2003: macro para advertir cuando la grabación caducará en 31 días
Este tutorial de Excel muestra cómo escribir una macro para advertirle (con capturas de pantalla e instrucciones paso a paso) cuando vencen los registros en 31 días en Excel 2003 y versiones anteriores.
Pregunta: Trabajamos con subcontratistas que tienen certificados de seguro que vencen en diferentes fechas. Almacenamos estos certificados y fechas de vencimiento en Microsoft Excel 2003/XP/2000/97.
¿Hay alguna forma en Excel de advertirme cuando un certificado específico está a punto de caducar?
R: Hay varios “eventos” disponibles en las hojas de cálculo de Excel donde puede colocar el código VBA. En su caso, queremos poner nuestro código en el evento “Workbook_Open”.
Veamos un ejemplo.
Descargue la hoja de cálculo de Excel (que se muestra a continuación)
En nuestra hoja de cálculo, tenemos una hoja llamada Hoja1. En la columna C, almacenamos la fecha de vencimiento de cada certificado de seguro.
Cuando se abre el archivo de Excel, el código VBA en el evento “Workbook_Open” se ejecuta automáticamente para verificar las primeras 200 filas en esta hoja de cálculo. Verifique cada fila para ver si el certificado caducará dentro de los próximos 31 días.
En nuestro ejemplo, abrimos el archivo el 1 de septiembre de 2003. En este caso obtendremos el siguiente mensaje de advertencia:
Esta macro generará un mensaje de advertencia para cada certificado que vencerá en los próximos 31 días.
Puede presionar Alt+F11 para ver el código VBA.
codigo macro
El código de la macro se ve así:
Private Sub Workbook_Open()
Dim LRow As Integer
Dim LResponse As Integer
Dim LName As String
Dim LDiff As Integer
Dim LDays As Integer
LRow = 2
'Warning - Number of days to check for expiration
LDays = 31
'Check the first 200 rows in column C
While LRow < 200
'Only check for expired certificate if value in column C is not blank
If Len(Sheets("Sheet1").Range("C" & LRow).Value) > 0 Then
LDiff = DateDiff("d", Date, Sheets("Sheet1").Range("C" & LRow).Value)
If (LDiff > 0) And (LDiff <= LDays) Then
'Get subcontractor name
LName = Sheets("Sheet1").Range("A" & LRow).Value
LResponse = MsgBox("The insurance certificate for " & LName & " will expire in " & LDiff & " days.", vbCritical, "Warning")
End If
End If
LRow = LRow + 1
Wend
End Sub