Private Sub cmdShowD_Click()

If Application.Intersect(ActiveCell, ActiveSheet.UsedRange) Is Nothing Then Exit Sub

ActiveCell.EntireRow.Copy Sheets("Буфер").Rows(2)
cPathD = ActiveWorkbook.Path & "\"
cCellName = ActiveCell.Address(False, False, xlA1)

Set WD = CreateObject("Word.Application")
WD.Visible = True
WD.Documents.Open Filename:=cPathD & "Договор.doc"

WD.Documents.Save True

Const wdPrintAllDocument = 0
Const wdPrintDocumentContent = 0
Const wdPrintAllPages = 0

cPrinter = WD.Application.ActivePrinter
WD.Application.ActivePrinter = "PDFCreator"
WD.Application.PrintOut Filename:=cPathD & "Договор.doc", _
PrintToFile:= True, _
OutputFileName:=cPathD & "Отчет " & cCellName & ".pdf", _
Range:=wdPrintAllDocument, Item:=wdPrintDocumentContent, _
Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=True, _
PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
WD.Application.ActivePrinter = cPrinter

WD.Application.Quit
Set WD = Nothing

End Sub