+- Forum Pplware (http://forum.pplware.com)
+-- Fórum: Mais Tech (/forumdisplay.php?fid=11)
+--- Fórum: Programação e Web (/forumdisplay.php?fid=16)
+--- Tópico: Visual Básic - Ajuda para correcção de código (/showthread.php?tid=2162)
Visual Básic - Ajuda para correcção de código - Telmo M. - 18-04-2009 19:04
Boas!
Precisava da vossa ajuda se possível!
Tenho um problema em que é preciso fazer o programa em VBA. Já tenho o código todo feito mas parece que dá erro.
O problema é o seguinte:
Um ano é bissexto se é divisível por 400, ou por 4 mas não por 100. Supondo que que o dia de Natal do ano 1900 foi a uma terça feira, elabore um algoritmo (pseudo-código mais fluxograma) e o respectivo programa em VBA que solicite ao utilizador um ano maior que 1900, e diga em que dia da semana é que calha o dia de Natal nesse ano.
Considere os valores ao acaso e demonstre o funcionamento do algoritmo através de uma tabela "verdade/estado"
À ferente de cada instrução do VBA escreva um comentário a explicar o que é que a mesma faz no contexto deste programa.
O que eu queria é que se possível me desse uma vista de olhos no código afim de descobrir o erro!
Dim Data, txtData As Date
Dim DiasDoAno, Dias31, AnosBiss, Dia, Mes, Ano As Integer
Dim Anos, NumDias As Long
Anos = Ano - 1900
Data = Format("dd/mm/yyyy", Date)
txtData = Data
Dia = Mid(Data, 1, 2)
Mes = Mid(Data, 4, 5)
Ano = Mid(Data, 7, 10)
If (Mes < 9) Then
Dias31 = Mes Mod 2
Else
Dias31 = (Mes + 1) Mod 2
End If
'Número de dias do ano dado, considerando fevereiro como tendo 30 dias
DiasDoAno = 30 * (Mes - 1) + Dia + Dias31
'Retifica o numero de dias de fevereiro
If (Mes >= 2) Then
ElseIf ((Ano Mod 4 <> 0) Or ((Ano Mod 100 = 0) And (Ano Mod 400 <> 0))) Then
DiasDoAno = DiasDoAno - 2
Else
DiasDoAno = DiasDoAno - 1
End If
'Numero de anos bissexto entre o ano dado é 1600
AnosBiss = ((Ano Mod 4) - 400 - (Ano Mod 100 - 16) + (Ano Mod 400 - 4) + 1)
'Numero de dias entre a data dada e 01/01/1900
If (Ano = 1900) Then
NumDias = DiasDoAno
Else
NumDias = Anos * 365 + DiasDoAno + AnosBiss
End If
'Dia da semana
Select Case NumDias Mod 7
Case 1
MsgBox "Sabado"
Case 2
MsgBox "Domingo"
Case 3
MsgBox "Segunda"
Case 4
MsgBox "Terça"
Case 5
MsgBox "Quarta"
Case 6
MsgBox "Quinta"
Case 7
MsgBox "Sexta"
End Select
End Function
Desde já obrigado!
Com os melhores cumprimentos,
Telmo M.