[γιώργοςΚ]

Γιώργο ο κώδικας όπως τον έχω διαμορφώσει και δίνει το επισυναπτόμενο μήνυμα

Private Sub cmdExtractAndFillWDCells_Click()

Dim appWord As Object, D As String, K As String
Dim Col As Integer, Row As Integer, DocName As String
Dim doc As Object

DocName = "ΗμερήσιαΥπηρεσίαΑξιωματι� �ών.dot"

If Me.RecordsetClone.RecordCount Then

On Error Resume Next
Err.Clear

Set appWord = GetObject(, "Word.Application")

If Err.Number <> 0 Then

Set appWord = CreateObject("Word.Application")

End If

On Error GoTo errHandler
' έχω αντικαταστήσει με την νέα γραμμή κώδικα
Set doc = doc.ActiveDocument
' Set doc = appWord.Documents(appWord.Documents.Count)

With Me.RecordsetClone
.MoveFirst
Do Until .EOF
D = ![cboDay]
K = ! cboKathikon
Row = Switch(K = "Α1", 2, K = "Α2", 3, K = "Α3", 4, K = "Α4", 5, K = "Α5", 6, K = "Α6", 7, K = "Α7", 8)
Col = Switch(D = "Δευτέρα", 2, D = "Τρίτη", 3, D = "Τετάρτη", 4, D = "Πέμπτη", 5, _
D = "Παρασκευή", 6, D = "Σάββατο", 7, D = "Κυριακή", 8)

doc.Tables(1).Cell(Row, Col).Range = !txtAll
.MoveNext
Loop
End With

appWord.Visible = True
appWord.Activate

End If

Set doc = Nothing

Set appWord = Nothing

Exit Sub

errHandler:

MsgBox Err.Number & ": " & Err.Description
End Sub