Word: Code errechnen und in Tabelle einfügen

Option Explicit
Private Const cHERSTELLERID = 012
Private Const cTAB_Z_ANZAHL = 28
Private Const cTAB_SP_ANZAHL = 19
Private Const cTAB_SP_DISTANZ = 2
'**************
Sub Word_TabAusfuellen()

 
 Dim Doc As Document, myTab As Table
 Dim dDatum As Date
 Dim sAusgabe As String
 
->Document setzen, auf dem der Makro arbeiten soll
 Set Doc = ActiveDocument
 
->Tabelle setzen, auf dem der Makro arbeiten soll
 On Error Resume Next
 Set myTab = Doc.Tables(1)
 On Error GoTo 0
 If myTab Is Nothing Then
  MsgBox Keine Tabelle im Dokument  & Doc.Name & . -> Abbruch
 End If
 
->DatumsEingabe
 If Not DatumsEingabe(dDatum) Then GoTo AUFRAEUMEN
 
->Ausgabestring zusammenstellen
 sAusgabe = _
  cHERSTELLERID & _
  Format(Year(dDatum) - 100, 0000) & _
  Format(Month(dDatum), 00) & _
  Format(Day(dDatum), 00)
 
 If Not TabAusfuellen(myTab, sAusgabe) Then GoTo AUFRAEUMEN
 
AUFRAEUMEN:
 Set Doc = Nothing: Set myTab = Nothing
End Sub
'****************
Private Function DatumsEingabe(dDatum As Date) As Boolean
 Dim sDatum As String
 DatumsEingabe = False
->heutiges Datum
 dDatum = Now()
 
->Eingabe datum mit vrogabe des heutigen Datums
 sDatum = InputBox( _
  Bitte geben Sie das Datum in der Form DD.MM.JJJJ ein., _
  Datumseingabe, Format(dDatum, dd.mm.yyyy))
 
->Eingabe prüfen
 On Error Resume Next
 dDatum = sDatum
 If Err.Number <> 0 Then
  Err.Clear
  MsgBox Datum-> & sDatum &-> konnte nicht als Datum interpretiert werden.
 Else
  DatumsEingabe = True->Datum ok
 End If
 On Error GoTo 0
End Function
'****************
Private Function TabAusfuellen(myTab As Table, sAusgabe As String) As Boolean
 Dim z As Long, sp As Long
 
 On Error Resume Next
 
 For z = 1 To cTAB_Z_ANZAHL
  For sp = 1 To cTAB_SP_ANZAHL Step cTAB_SP_DISTANZ
   myTab.Cell(z, sp).Range.Text = sAusgabe
   If Err.Number <> 0 Then GoTo ENDEBEARBEITUNG
  Next
 Next
ENDEBEARBEITUNG:
 If Err.Number <> 0 Then
  MsgBox _
   Beim Ausfüllen der Tabelle trat ein Fehler auf. & vbCrLf & _
   Zeile  & z &  Spalte  & sp
  Err.Clear
  TabAusfuellen = False
 Else
  TabAusfuellen = True->alles ok
 End If
 On Error GoTo 0
End Function