Function QS(RetVal)

     Dim i As Long  

        For i = 1 To Len(RetVal)

            QS = QS + Val(Mid(RetVal, i, 1))

        Next i

End Function



Function OpCode()

    Dim Date_ As String, d As String

    Dim d_sum As Long

    Dim N, E As String

    

        Date_ = Date  ' Datum des heutigen Tages i.d. Form "Tag.Monat.Jahr"

      

        Date_ = DateAdd("d", 28, Date_) ' zu Date_ 28 Tage addieren

        

        d_sum = Val(Left(Date_, 2) & Mid(Date_, 4, 2) & Right(Date_, 4))

        

        Do

            d_sum = QS(d_sum)

        Loop Until d_sum < 10

        

        d_sum = (d_sum * (&HA - 1)) + &HB0

        

        Do

            d_sum = QS(d_sum)

        Loop Until d_sum < 10

        

        N = "N53 30." + Right(Str((2 ^ &HA) - (6 * d_sum)), 3)

        E = "E10 01." + Right(Str((111 * (2 + d_sum)) - &H28), 3)

        

        MsgBox "Die Koordinaten lauten " & N & " " & E



End Function