Private Sub SemanaAtual()
  On Error GoTo Erro
  Ano = Mid(CStr(Year(Date)), 3, 2)
  PrimeiroDeJaneiro = CDate("01/01/" & Ano)
  DiaDaSemana = Weekday(PrimeiroDeJaneiro)
  If DiaDaSemana = 1 Then
    PrimeiroDia = PrimeiroDeJaneiro
  ElseIf DiaDaSemana = 2 Then
    PrimeiroDia = PrimeiroDeJaneiro - 1
  ElseIf DiaDaSemana = 3 Then
    PrimeiroDia = PrimeiroDeJaneiro - 2
  ElseIf DiaDaSemana = 4 Then
    PrimeiroDia = PrimeiroDeJaneiro - 3
  ElseIf DiaDaSemana = 5 Then
    PrimeiroDia = PrimeiroDeJaneiro - 4
  ElseIf DiaDaSemana = 6 Then
    PrimeiroDia = PrimeiroDeJaneiro - 5
  ElseIf DiaDaSemana = 7 Then
    PrimeiroDia = PrimeiroDeJaneiro - 6
  End If
  If Date - PrimeiroDia < 6 Then
    Int_Semana = 1
  Else
    Int_Semana = Int((Date - PrimeiroDia) / 7) + 1
  End If
  If Int_Semana < 10 Then
    Str_Semana = Format(CStr(Int_Semana), "00") & "/" & Ano
  Else
    Str_Semana = Format(CStr(Int_Semana), "00") & "/" & Ano
  End If
  MsgBox Str_Semana
  Exit Sub
Erro:
  Screen.MousePointer = vbDefault
  MsgBox "Ocorreu o erro nº " & Err.Number & vbCr & vbCr & Err.Description, 64, "Atenção"
  Err.Clear
End Sub

Jayme