Private Sub Att_responce(Printonly As Boolean)
If IsNull(Me.fid_response) Then
    MsgBox  "Для печати письма сотруднику - результата аттестации необходимо выбрать тип письма" 
    Exit Sub
End If

Dim Shablon, Find_str, Replace_str
Dim wrd, Newdol As String
Dim male, IO
male = Me.Parent.p1.Form.male
IO = Me.Parent.p1.Form.ИМЯ &  " "  & Me.Parent.p1.Form.Отчество
'Имя файла - шаблона'
Shablon = Me.fid_response.Column( 2 )
'Для соответствующих должности'
If Me.fid_response <>  3  Then
    Newdol = Nz(Me.fid_newdol.Column( 1 ),  "")
Else
    Newdol = Me.Parent.p1.Form.dol_name
End If
If Newdol <> "  " Then
    Newdol = Replace(Newdol, " ий  ", " его  ", , , vbTextCompare)
    Newdol = Replace(Newdol, " ый  ", " ого  ", , , vbTextCompare)
    Newdol = Newdol & " а "
    Newdol = LCase(Newdol)
End If

If Newdol = "  " And (Me.fid_response = 1  Or Me.fid_response =  4 ) Then
    MsgBox "Для выбранного вами типа письма необходимо указать новую должность "
    Exit Sub
End If

Set wrd = CreateObject(" Word.Application ")
 wrd.Application.Documents.Add Template:=" C:\base\Шаблоны_кадры\ " & Shablon _
        , NewTemplate:=False, DocumentType:=0 

'    Заменяемые тэги'
'<ый/ая>
'<Имя_Отчество>
'<дата_комиссии>
'<Новая_должность_в_ВП>
    
Find_str = "<ый/ая> "
If male = True Then Replace_str = " ый " Else Replace_str = " ая "
GoSub Rplace

Find_str = " <Имя_Отчество> "
Replace_str = IO
GoSub Rplace

Find_str = " <дата_комиссии> "
Replace_str = Me.Parent.a_s_date
GoSub Rplace

Find_str = " <Новая_должность_в_ВП> "
Replace_str = Newdol
GoSub Rplace

If Printonly Then
 '   ActivePrinter = " \\DATASERVER\HP LaserJet 6P "
    wrd.Application.PrintOut FileName:="  ", Range:=0 , Item:= _
         0 , Copies:= 1 , Pages:="", PageType:= 0 , _
        ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
        False, PrintZoomColumn:= 0 , PrintZoomRow:= 0 , PrintZoomPaperWidth:= 0 , _
        PrintZoomPaperHeight:= 0 
    wrd.Application.Quit
Else
    wrd.Application.Visible = True
End If


Exit Sub

Rplace:
    With wrd.Application.selection.Find
        .Text = Find_str
        .Replacement.Text = Replace_str
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    wrd.Application.selection.Find.Execute Replace:= 2 
Return
End Sub