Таблица раскрашивается условным форматированием, а на печать нужно отправлять без него, макрорекордером частично получилось Подскажите как доработать макрос?
Код
Sub печать_без_уф()
' здесь нужно запомнить примененное УФ
' выбираем диапазон и отключаем УФ
Range("D4:H28").Select
Selection.FormatConditions.Delete
'отправляем на печать
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
'возвращаем УФ
End Sub
edkudin, Все зависит от того что в УФ, но мне кажется проще добавить в УФ условие по которому включать и отключать его. В противном случае, придется разбираться с диапазоном УФ, А так как их может быть несколько, то сохранять в массив, потом восстанавливать, что в разы сложнее.
Sub qq()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
With ActiveSheet
.Copy Before:=Sheets(1)
.Cells.FormatConditions.Delete
.Range("D4:H28").PrintOut
.Delete
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
RAN немножко не то, но сама мысль мне понравилась, и создание дубля я взял на вооружение, я просто сделал второй лист-копию и формирую на нём измененный документ без УФ прочей "чепухи" а для печати сделал пару кнопок "печать в цвете" и "печать отчетная" и нужный лист идет в печать. Спасибо за идею.
edkudin, Но ведь всегда есть соблазн напечатать без кнопки, да и в случае коррекции необходимо править в двух местах. Пришла в голову идея. Делаете просто доп. УФ с остановкой при выполнении условия и несколько строк кода.
Код
Private Sub Workbook_BeforePrint(Cancel As Boolean)
ThisWorkbook.Names("NoColor").Value = 1
Application.OnTime Now + CDate("0:0:1"), "NoColorReset"
End Sub
Sub NoColorReset()
ThisWorkbook.Names("NoColor").Value = 0
End Sub
Только тема переросла в "Как напечатать с отключенным УФ?".
Еще вариант, правда в нем после восстановления УФ все значения ячеек становятся невидимыми)
Код
Sub CondFlash()
Dim aa As Range, arr(), a&, b&, c&, dd(), cc()
Set aa = [D4].CurrentRegion
ReDim arr(1 To aa.Rows.Count, 1 To aa.Columns.Count)
For a = 1 To aa.Rows.Count
For b = 1 To aa.Columns.Count
If aa(a, b).FormatConditions.Count > 0 Then
ReDim dd(1 To aa(a, b).FormatConditions.Count): ReDim cc(1 To 12)
For c = 1 To UBound(dd)
With aa(a, b).FormatConditions.Item(c)
cc(1) = .Type: cc(2) = .Operator
cc(3) = Replace(.Formula1, "=", "")
cc(4) = Replace(.Formula2, "=", ""): cc(5) = .Priority
cc(6) = .NumberFormat: cc(7) = .Interior.Color: cc(8) = .Font.Color
cc(9) = .Font.Bold: cc(10) = .Font.Italic: cc(11) = .StopIfTrue
cc(12) = .AppliesTo.Address: dd(c) = cc
End With
Next
arr(a, b) = dd
End If
Next
Next
aa.FormatConditions.Delete
'-----------
MsgBox "FormatConditions store to Array and Deleted. Ready for Print!"
'-----------
Application.ScreenUpdating = False
For a = 1 To aa.Rows.Count
For b = 1 To aa.Columns.Count
If IsArray(arr(a, b)) Then
For c = 1 To UBound(arr(a, b))
aa(a, b).FormatConditions.Add Type:=arr(a, b)(c)(1), Operator:=arr(a, b)(c)(2), _
Formula1:=arr(a, b)(c)(3), Formula2:=arr(a, b)(c)(4)
With aa(a, b).FormatConditions(c)
.Priority = arr(a, b)(c)(5): '.NumberFormat = arr(a, b)(c)(6)
.Interior.Color = arr(a, b)(c)(7): .Font.Color = arr(a, b)(c)(8)
.Font.Bold = arr(a, b)(c)(9): .Font.Italic = arr(a, b)(c)(10)
.StopIfTrue = arr(a, b)(c)(11)
End With
Next
End If
Next
Next
Application.ScreenUpdating = True
MsgBox "FormatConditions restored!"
End Sub
Anchoret оригинальное скрытие значений ячейки! Причем если удалить из части ячеек УФ то значения появляются, но при повторном применении УФ или формате по образцу УФ восстанавливается и значений нет! если "тупо" ввести по новой значение в ячейке оно появляется..
Господа а возможность применения УФ макросами есть? Типа такого алгоритма: 1 заполняем значения таблицы и при этом, на какое либо событие включается применение УФ макросом, т.к. таблица маленькая можно хоть после ввода в каждой ячейке пересчитывать 2 документ сформирован и рассчитан, 3 если необходима печать то сбрасываем УФ 3 печать без УФ 4 восстановление УФ ?
на вашем примере у меня дебуг на этом выскакивает- Set aa = [D4].CurrentRegion: arr1 = aa.FormulaLocal
почему УФ? да просто первое что пришло в голову и реализация была очень простой, и визуально вся картина "складывалась по цветам в мозгу при взгляде " но потом оказалось что необходимо бланки тестов без цвета отпечатывать и подшивать в дело...
Виноват, не доглядел. Действительно печатает ч\б. А можно расшифровать что вы в данном случае сделали, что-бы на реальный документ можно было применить?
1. доп условный фильтр пустышка, с остановкой и применяемы по значению в переменной 2. В имена занесена эта переменная, по умолчанию там 0 3. Коды в соответствующих модулях.
Работает все просто . Перед печатью переменной присваивается 1, что останавливает работу всех "цветных" УФ. сраз ставится задание по таймеру вернуть значение в 0, но отработает это только после печати.
Anchoret спасибо, работает. БМВ не могу своим тугоумием реализовать в оригинальном файле то, что вы предложили, как я делал: создал в ДИ NoColor в Module1 скопировал с вашего 3 строки в ЭтаКнига скопировал с вашего 4 строки в УП УФ создал правило-формулу.... не работает...
edkudin, Правило дополнительное самое верхнее? Оно должно проверятся и выполнятся первым. Проверить эту часть просто, в ДИ в переменную поставить не 0, а например 1. Если актуально, то создайте с нуля крохотный пример, и если не работает, выкладывайте, посмотрю, в чем ошибка.
ИДИОТ...( это я про себя)... полез перепроверять и нашел косяк: у меня NoColor была в кавычках почему-то, исправил и всё заработало!
Итоговый документ сделал Anchoret+БМВ с кнопок печатает без "УФ+модификация ответов+скрытие некоторой инфы" или только выводы по тесту а если просто через печать отправлять, то "исходник без УФ" Всем огромнейшее спасибо!!!
Михаил Лебедев, Михаил, но ведь это не совсем ответ на вопрос, ибо будет обесцвечено все, включая то что нужно и нет, условный и обычный формат. например заголовок таблицы на фоне станете сильно иным.
P.S. в теме по ссылке ключевые слова "и заливку" делают вариант полностью советующим вопросу. Тут не совсем.
в моем документе так не прокатит, т.к. есть много ячеек залитых просто цветом, и кроме того в "системе " более 20ти принтеров, а вот куда и как отправить это мы решили с помощью этого форума ещё год назад, и в вашем случае на печати они будут в градациях серого, такие варианты я пробовал, со всеми цветами легко было разобраться а вот с УФ не очень, но спасибо ВАМ нашел кучу "полезностей"
Господа, что не так? Начал отдавать тест на другие компы и полезли глюки: должно быть при простой печати всё ч\б кроме строк 31-35; при нажатии "печать в цвете" просто печать листа; при нажатии "печать ч/б" печать без УФ и строк 30-36; при нажатии печать" без таблиц" печать без строк 3-36; и всегда возврат к исходнику, а сейчас все кнопки живут своей жизнью и по окончании макроса к исходному не возврвщают
У меня вылетает на предпоследней строке, на : .Operator
Код
Sub печать_ч_б()
' печать_ч_б Макрос
снимаем_защиту
Dim aa As Range, arr(), a&, b&, c&, dd(), cc()
Set aa = [D4].CurrentRegion
ReDim arr(1 To aa.Rows.Count, 1 To aa.Columns.Count)
For a = 1 To aa.Rows.Count
For b = 1 To aa.Columns.Count
If aa(a, b).FormatConditions.Count > 0 Then
ReDim dd(1 To aa(a, b).FormatConditions.Count): ReDim cc(1 To 11)
For c = 1 To UBound(dd)
With aa(a, b).FormatConditions.Item(c)
cc(1) = .Type: cc(2) = .Operator
cc(3) = Replace(.Formula1, "=", "")
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/