Sub ЦвПечать()
    Dim sFolder As String, sFiles As String, fFile As String
    
    sFolder = ThisWorkbook.Sheets("Лист1").Cells(1, 1).Value
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
'    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.xls*")
    If sFiles = "" Then Exit Sub
    fFile = sFiles
    Do
        If sFiles <> ThisWorkbook.Name Then
            Workbooks.Open sFolder & sFiles
            ActiveWorkbook.ActiveSheet.PageSetup.BlackAndWhite = False
            ActiveWorkbook.Close True
        End If
        sFiles = Dir
    Loop While (sFiles <> "") And (sFiles <> fFile)
'    Application.ScreenUpdating = True
End Sub