PROGRAMA CALENDARIO PERPÉTUO

Se introducen dos botones, dos combobox, 7 labels i luego una matriz de 36 labels

El código será el siguiente:

Private Sub Combo1_Change()

If Combo1.Text <> "" And Combo2.Text <> "" Then

Command1.Enabled = True

Else

Command1.Enabled = False

End If

End Sub

Private Sub Combo1_Click()

If Combo1.Text <> "" And Combo2.Text <> "" Then

Command1.Enabled = True

Else

Command1.Enabled = False

End If

End Sub

Private Sub Combo1_LostFocus()

If Combo1.Text <> "" And Combo2.Text <> "" Then

Command1.Enabled = True

Else

Command1.Enabled = False

End If

End Sub

Private Sub Combo2_Change()

If Combo1.Text <> "" And Combo2.Text <> "" Then

Command1.Enabled = True

Else

Command1.Enabled = False

End If

End Sub

Private Sub Combo2_Click()

If Combo1.Text <> "" And Combo2.Text <> "" Then

Command1.Enabled = True

Else

Command1.Enabled = False

End If

End Sub

Private Sub Combo2_LostFocus()

If Combo1.Text <> "" And Combo2.Text <> "" Then

Command1.Enabled = True

Else

Command1.Enabled = False

End If

End Sub

Private Sub Command1_Click()

Dim numdias As Integer

Dim nummes As Integer

Dim diasemana As Integer

Dim diames As Integer

Dim pos As Integer

Dim d As Integer

For d = 0 To 36

Dias(d).Appearance = 1

Dias(d).Caption = ""

Dias(d).Font = "Arial"

Dias(d).FontBold = True

Dias(d).FontSize = 26

Dias(d).Alignment = 2

Next

diasmes = 0

Select Case Combo1.Text

Case "Enero"

numdias = 31

nummes = 1

Case "Febrero"

If Val(Combo2.Text) Mod 4 = 0 Then

numdias = 29

Else

numdias = 28

End If

nummes = 2

Case "Marzo"

numdias = 31

nummes = 3

Case "Abril"

numdias = 30

nummes = 4

Case "Mayo"

numdias = 31

nummes = 5

Case "Junio"

numdias = 30

nummes = 6

Case "Julio"

numdias = 31

nummes = 7

Case "Agosto"

numdias = 31

nummes = 8

Case "Septiembre"

numdias = 30

nummes = 9

Case "Octubre"

numdias = 31

nummes = 10

Case "Noviembre"

numdias = 30

nummes = 11

Case "Diciembre"

numdias = 31

nummes = 12

End Select

fecha = CDate("1/" + Str(nummes) + "/" + Combo2.Text)

diasemana = Weekday(fecha, 2)

pos = diasemana

For d = diasemana To (numdias + diasemana)

If diasmes < numdias Then

Dias(d - 1).Appearance = 0

diasmes = diasmes + 1

If pos = 6 Then

Dias(d - 1).ForeColor = vbBlue

ElseIf pos = 7 Then

Dias(d - 1).ForeColor = vbRed

pos = 0

Else

Dias(d - 1).ForeColor = vbBlack

End If

Dias(d - 1).Caption = diasmes

pos = pos + 1

End If

Next

End Sub

Private Sub Command2_Click()

End

End Sub

Private Sub Form_Load()

Combo1.AddItem "Enero"

Combo1.AddItem "Febrero"

Combo1.AddItem "Marzo"

Combo1.AddItem "Abril"

Combo1.AddItem "Mayo"

Combo1.AddItem "Junio"

Combo1.AddItem "Julio"

Combo1.AddItem "Agosto"

Combo1.AddItem "Septiembre"

Combo1.AddItem "Octubre"

Combo1.AddItem "Noviembre"

Combo1.AddItem "Diciembre"

Dim x As Integer

For x = 1900 To 2100

Combo2.AddItem Str(x)

Next

Command1.Enabled = False

End Sub