Notificación de evento con 10 días de anterioridad

Hace algún tiempo (tantos que ya no lo recuerdo) descargue un archivo titulado CUMPLEAÑEROS DEL MES el cual me ha sido muy util para este propósito.

El caso es que deseo añadir un mensaje donde me liste los cumpleañeros del día y además el de los cumpleañeros de los 10 días siguientes.

Anexo el código completo del archivo.

Agradeciendo de antemano su ayuda.

Saludos.

Código del userform

Private Sub CommandButton1_Click()

Dim Base As String
Dim seg As String

'Codigo suministrado por la señora experta Elsa Matilde

If TextBox1.Text = "" Then

MsgBox "Falta ingresar nombre", vbExclamation, "Atencion"
TextBox1.SetFocus

ElseIf TextBox2.Text = "" Then

MsgBox "Falta ingresar apellido", vbExclamation, "Atencion"
TextBox2.SetFocus

ElseIf TextBox3.Text = "" Then

MsgBox "Falta ingresar fecha", vbExclamation, "Atencion"
TextBox3.SetFocus

ElseIf TextBox4.Text = "" Then

MsgBox "Falta ingresar departamento", vbExclamation, "Atencion"
TextBox4.SetFocus

ElseIf TextBox5.Text = "" Then

MsgBox "Falta ingresar cargo u ocupacion", vbExclamation, "Atencion"
TextBox5.SetFocus

ElseIf Label6.Caption = "REGISTRADO" Then

MsgBox "Imposible registrar", vbExclamation, "Atencion"

Exit Sub

TextBox1.SetFocus

Else

seg = MsgBox("Esta seguro de guardar?", vbQuestion + vbYesNo, "Seguro")
If seg = vbYes Then

Sheets("base de datos").Activate
Base = Sheets("Base de datos").Range("A65536").End(xlUp).Row + 1
Sheets("Base de datos").Cells(Base, 1) = UCase(TextBox1)
Sheets("Base de datos").Cells(Base, 2) = UCase(TextBox2)
Sheets("Base de datos").Cells(Base, 5) = CDate(TextBox3)
Sheets("Base de datos").Cells(Base, 6) = UCase(TextBox4)
Sheets("Base de datos").Cells(Base, 7) = UCase(TextBox5)

TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox1.SetFocus

MsgBox "Datos cargados exitosamente", vbInformation, "Sistema"

Else

Exit Sub

End If

End If

End Sub

Private Sub CommandButton2_Click()

Unload Me

End Sub

Private Sub CommandButton3_Click()

TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox1.SetFocus

End Sub

Private Sub Label2_Click()

End Sub

Private Sub Label5_Click()

End Sub

Private Sub TextBox1_Change()

Dim n As Range

If TextBox1.Text <> "" Then

Set n = Worksheets("Base de datos").Range("a2:a5000").Find(What:=TextBox1.Text, lookat:=xlWhole)

If Not (n Is Nothing) Then
Label6.Caption = "REGISTRADO"
Label6.BackColor = &HFF&
Label6.ForeColor = &HFFFFFF
Else
Label6.Caption = "NUEVO"
Label6.BackColor = &HFF00&
Label6.ForeColor = &H80000012

End If

End If
If TextBox1.Text = Empty Then
Label6.Caption = Empty
Label6.BackColor = &H8000000F

End If

End Sub

Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

Dim largo_entrada As Integer
largo_entrada = Len(Me.TextBox3)
Select Case largo_entrada
Case 2
Me.TextBox3.Value = Me.TextBox3.Value & "/"
Case 5
Me.TextBox3.Value = Me.TextBox3.Value & "/"
End Select

End Sub

Private Sub UserForm_Click()

End Sub

CÓDIGO DEL MÓDULO 1

Sub Filtrar()

Dim cuenta As Double

Sheets("PLATAFORMA").Select
Range("C2").Select

Sheets("PLATAFORMA").Select
Sheets("BASE DE DATOS").Columns("A:I").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("A1:B2"), CopyToRange:=Range("PLATAFORMA!Extract"), _
Unique:=False
cuenta = WorksheetFunction.CountA(Range("D2:D5000"))

If Range("D2") = Empty Then

MsgBox "SIN REPORTES", vbInformation, "*SIN CUMPLEAÑOS*"

Else

MsgBox " HOY TENEMOS" & " " & cuenta & " " & " CUMPLEAÑOS", vbExclamation, "*CUMPLEAÑOS*"

End If

End Sub

Sub cierra()

End Sub

Sub Formulario()

Worksheets(2).ShowDataForm

End Sub

Sub ContarRegistros()

Dim cuenta As Double
cuenta = WorksheetFunction.CountA(Range("A2:A5000"))
MsgBox "CONTAMOS CON " & " " & cuenta, vbInformation, "REGISTROS"

End Sub

Sub Regresar()

Sheets("BASE DE DATOS").Visible = False
Sheets("PLATAFORMA").Select
Range("A1").Select

End Sub

Sub VerBasedeDatos()

Sheets("BASE DE DATOS").Visible = True
Sheets("BASE DE DATOS").Select
Range("E1").Select

End Sub

Sub VerLibrosAbiertos()

Dim contar As Byte
For contar = 1 To Windows.COUNT
MsgBox Windows(contar).Caption, vbInformation, "windows"
Next

End Sub

Sub Proteger_hoja_activa()

ActiveSheet.Protect
MsgBox "Hoja protegida"

End Sub

Sub Desproteger_hoja_activa()

ActiveSheet.Unprotect
MsgBox "Hoja protegida"

End Sub

Sub Ingresar()

userform1.Show

End Sub