Visual Básic - Ajuda para correcção de código
|
18-04-2009, 19:04
(Esta mensagem foi modificada pela última vez a: 19-04-2009 13:58 por Telmo M..)
Mensagem: #1
|
|||
|
|||
Visual Básic - Ajuda para correcção de código
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. |
|||
« Mais Antigo | Mais Recente »
|
Mensagem neste Tópico |
Visual Básic - Ajuda para correcção de código - Telmo M. - 18-04-2009 19:04
|
Utilizadores a ver este tópico: 2 Visitante(s)