Dim aQuersumme As Long
  Dim I As Integer
  Dim Summe As String
 
  Summe = Text1.Text
  Do
    aQuersumme = 0
    For I = 1 To Len(Summe)
      aQuersumme = aQuersumme + Val(Mid$(Summe, I, 1))
    Next I
    Summe = CStr(aQuersumme)
  Loop Until aQuersumme < 10
  Text2.Text = Summe