Private Sub zapolnit()
    nm = TEST.DOC
    gd = ActiveWorkbook.Sheets(1).Range("A1")
    pr = ActiveWorkbook.Sheets(1).Range("B1")

    Set objWord = CreateObject("word.application")
    objWord.Visible = True
    Set objDoc = objWord.Documents.Open(ActiveWorkbook.Path & nm)
    
    Call telo
    
    objDoc.SaveAs2 Filename:=ActiveWorkbook.Path & "\Rezult\" & Left(nm, 5) & "_" & Format(gd, "00") & Format(pr, "00") & ".docx"
    objWord.Quit
End Sub
Private Sub telo()

For bMi = 1 To objDoc.Bookmarks.Count
        If (Len(objDoc.Bookmarks(bMi).Name) - Len(Replace(objDoc.Bookmarks(bMi).Name, "_", ""))) <> 4 Then GoTo NxtBM
        tmpBM = Split(objDoc.Bookmarks(bMi).Name, "_")
        If IsSh(tmpBM(LBound(tmpBM)) & "") = False Then GoTo NxtBM
        Set sh1 = ThisWorkbook.Sheets(tmpBM(LBound(tmpBM)) & "")
        rOw1 = Val(tmpBM(LBound(tmpBM) + 1))
        rOw2 = Val(tmpBM(LBound(tmpBM) + 2))
        cOl1 = Val(tmpBM(LBound(tmpBM) + 3))
        cOl2 = Val(tmpBM(LBound(tmpBM) + 4))
        objDoc.Bookmarks(bMi).Range.Select
        For i = rOw1 To rOw2
            Set r = objWord.Selection.Range
            For j = cOl1 To cOl2
                If Len(sh1.Cells(i, j).Value) = 0 Then
                    objWord.Selection.TypeText Text:="0"
                Else
                    If sh1.Cells(i, j).Value = 0 Then
                        objWord.Selection.TypeText Text:=" "
                    Else
                        objWord.Selection.TypeText Text:=CStr(sh1.Cells(i, j).Value)
                    End If
                End If
                If j <> cOl2 Then objWord.Selection.MoveRight unit:=wdCell
            Next j
            r.Select
            If i <> rOw2 Then objWord.Selection.MoveDown 'unit:=wdCell
        Next i

NxtBM:
    Next bMi
For bMi = 1 To objDoc.Bookmarks.Count
        If (Len(objDoc.Bookmarks(bMi).Name) - Len(Replace(objDoc.Bookmarks(bMi).Name, "_", ""))) <> 1 Then GoTo NxtgBM
        tmpBM = Split(objDoc.Bookmarks(bMi).Name, "_")
            If Mid(tmpBM(0), 1, 3) = "god" Then
                If tmpBM(0) = "god1" Then
                    objDoc.Bookmarks(bMi).Range.Select
                    objWord.Selection = Mid(Format(gd, "00"), 1, 1)
                        GoTo NxtgBM
                Else: objDoc.Bookmarks(bMi).Range.Select
                    objWord.Selection = Mid(Format(gd, "00"), 2, 2)
                        GoTo NxtgBM
                End If
            ElseIf Mid(tmpBM(0), 1, 3) = "mon" Then
                If tmpBM(0) = "mon1" Then
                    objDoc.Bookmarks(bMi).Range.Select
                    objWord.Selection = Mid(Format(pr, "00"), 1, 1)
                        GoTo NxtgBM
                Else: objDoc.Bookmarks(bMi).Range.Select
                    objWord.Selection = Mid(Format(pr, "00"), 2, 2)
                        GoTo NxtgBM
                End If
            End If
            
                        
NxtgBM:
    Next bMi
End Sub
Function IsSh(shN As String) As Boolean
Dim tmpobj As Worksheet
IsSh = False
On Error GoTo FIN
Set tmpobj = ThisWorkbook.Sheets(shN)
IsSh = True
FIN:
End Function