Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Microsoft Office и VBA > Microsoft Office Word
Регистрация

Восстановить пароль
Повторная активизация e-mail


Донат для форума - использовать для поднятия настроения себе и модераторам

А ещё здесь можно купить рекламу за 25 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru

Ответ
 
Опции темы
Старый 17.11.2009, 14:27   #11
rain_day
Пользователь
 
Регистрация: 17.11.2009
Сообщений: 14
Репутация: 10
По умолчанию

Знаешь, если принцип работает и дело действительно в том что ты говоришь, почему бы нам не разделить конечную цель на 2 макроса? Одну кнопь нажал - пошли чб страницы. Другую кнопь нажал - пошли цв страницы. Возможно, это даже удобнее будет в каких-то случаях. Щас даже попробую поколупать макрос, хотя вряд ли чего выдет у меня с первого раза
А! Еще заметил, что описаный мною результат получен именно на большом документе. А создав док из нескольких страниц для теста, там макрос вообще ни чего не делает. Ставит в очередь на печать и сразу убирает

или формирование списка страниц на принтеры сделать не одним оператором, а двумя. Т.е.

Если есть рис. то добавляем в цв список, в противном случае - ничего. Конец

Если нет рис. то добавляем в чб список, в противном случае - ничего. Конец

как-то так по-русски

Последний раз редактировалось Stilet; 18.11.2009 в 08:52.
rain_day вне форума   Ответить с цитированием
Старый 17.11.2009, 14:36   #12
viter.alex
Балуюсь кодами
Профессионал
 
Аватар для viter.alex
 
Регистрация: 09.01.2009
Адрес: Харків, Україна
Сообщений: 1,803
Репутация: 716

icq: 194381182
skype: viter.alex
По умолчанию

Попробуем проверять BackgroundPrintingStatus
Код:
Sub SeparatePrint()
  Const PRINTER_BW = "Принтер чернобелой печати"
  Const PRINTER_COLOR = "Принтер цветной печати"
  Dim sBWPages As String 'Строка для номеров страниц на ч\б печать
  Dim sColorPages As String 'Строка для номеров страниц на цветную печать
  Dim oDoc As Document: Set oDoc = ActiveDocument 'Документ, который нужно распечатать
  Dim nPage As Long: nPage = 1 'Номер страницы
  Dim oPageRng As Range 'Диапазон отдельной страницы
  Dim nPages As Long: nPages = oDoc.Range.ComputeStatistics(wdStatisticPages) 'Количество страниц в документе
  Do
    'Переходим в начало отдельной страницы
    Set oPageRng = oDoc.Range.GoTo(wdGoToPage, wdGoToAbsolute, nPage)
    'Растягиваем диапазон на всю страницу
    If nPage < nPages Then
      oPageRng.SetRange oPageRng.Start, oDoc.Range.GoTo(wdGoToPage, wdGoToAbsolute, nPage + 1).Start
    Else
      oPageRng.SetRange oPageRng.Start, oDoc.Range.End
    End If
    
    If oPageRng.InlineShapes.Count = 0 And oPageRng.ShapeRange.Count = 0 Then 'Если нет рисунков
      sBWPages = sBWPages & nPage & "," 'Добавляем в список страниц для печати на ч\б принтер
    Else 'Если есть рисунки
      sColorPages = sColorPages & nPage & "," 'Добавляем в список страниц для печати на цветной принтер
    End If
    nPage = nPage + 1
  Loop While nPage <= nPages
  sBWPages = Left(sBWPages, Len(sBWPages) - 1)
  sColorPages = Left(sColorPages, Len(sColorPages) - 1)
  ActivePrinter = PRINTER_BW 'Задаем ч\б принтер
  'Отправляем на печать ч\б страницы
  oDoc.PrintOut Range:=wdPrintRangeOfPages, Pages:=sBWPages
'------------------------------------------------------------------
  'Делаем задержку, пока задание на печать ещё не выполнено
  Do
    DoEvents
  Loop While Application.BackgroundPrintingStatus > 0
'------------------------------------------------------------------
  ActivePrinter = PRINTER_COLOR 'Задаем цветной принтер
  'Отправляем на печать цветные страницы
  oDoc.PrintOut Range:=wdPrintRangeOfPages, Pages:=sColorPages
End Sub
__________________
Лучше день потерять — потом за пять минут долететь!©

Последний раз редактировалось viter.alex; 17.11.2009 в 14:58. Причина: Исправил переменную, которая отправляется на цветную печать
viter.alex вне форума   Ответить с цитированием
Старый 17.11.2009, 14:47   #13
rain_day
Пользователь
 
Регистрация: 17.11.2009
Сообщений: 14
Репутация: 10
По умолчанию

Прогресс определённо есть! У меня теперь оба принтера напечатали только чб. А может после формирования списка на чб сразу отправлять его на печать? А потом формировать список цв и опять отправлять
rain_day вне форума   Ответить с цитированием
Старый 17.11.2009, 14:51   #14
viter.alex
Балуюсь кодами
Профессионал
 
Аватар для viter.alex
 
Регистрация: 09.01.2009
Адрес: Харків, Україна
Сообщений: 1,803
Репутация: 716

icq: 194381182
skype: viter.alex
По умолчанию

Ё-моё, и ты ничего не увидел!
Посмотри внимательно в код, какая переменная отправляется на цветную печать? Код пока исправлять не буду
__________________
Лучше день потерять — потом за пять минут долететь!©
viter.alex вне форума   Ответить с цитированием
Старый 17.11.2009, 14:55   #15
rain_day
Пользователь
 
Регистрация: 17.11.2009
Сообщений: 14
Репутация: 10
По умолчанию

ТЫ ГЕНИИИИИИЙ!!!!
Спасибо огромное, побежал счастливый тестировать в рабочем процессе!

А мне еще такая мысля пришла. Возможно еще при этом проверять графические объекты цветны или чб? И если чб, то пришивать их к списку чб

Последний раз редактировалось Stilet; 18.11.2009 в 08:53.
rain_day вне форума   Ответить с цитированием
Старый 17.11.2009, 15:17   #16
viter.alex
Балуюсь кодами
Профессионал
 
Аватар для viter.alex
 
Регистрация: 09.01.2009
Адрес: Харків, Україна
Сообщений: 1,803
Репутация: 716

icq: 194381182
skype: viter.alex
По умолчанию

Дай пример документа, где есть цветные и ч\б рисунки.
__________________
Лучше день потерять — потом за пять минут долететь!©
viter.alex вне форума   Ответить с цитированием
Старый 17.11.2009, 15:38   #17
rain_day
Пользователь
 
Регистрация: 17.11.2009
Сообщений: 14
Репутация: 10
По умолчанию

Прилагаю. Но его пришлось сохранить в формате doc вместо docx
Вложения
Тип файла: doc тест.doc (257.5 Кб, 11 просмотров)
rain_day вне форума   Ответить с цитированием
Старый 17.11.2009, 16:03   #18
viter.alex
Балуюсь кодами
Профессионал
 
Аватар для viter.alex
 
Регистрация: 09.01.2009
Адрес: Харків, Україна
Сообщений: 1,803
Репутация: 716

icq: 194381182
skype: viter.alex
По умолчанию

С наскока не получилось. Дело в том, что у объекта InlineShape, каковыми являются рисунки в предоставленном документе, есть свойство PictureFormat.ColorType. Но оно покажет, что рисунок ч\б только если к нему применить команду Перекрасить→Черно-белое. Если же этого не делать, тогда никак не определить.
Вернее, чистым VBA никак, но есть еще функции WinAPI, которые это могут. Но это совсем другая история
__________________
Лучше день потерять — потом за пять минут долететь!©
viter.alex вне форума   Ответить с цитированием
Старый 17.11.2009, 16:39   #19
rain_day
Пользователь
 
Регистрация: 17.11.2009
Сообщений: 14
Репутация: 10
По умолчанию

А как пришить к данному макросу хотя бы такую команду? Может и такой способ приживётся. Всё легче, чем выписывать номера страниц на листик
rain_day вне форума   Ответить с цитированием
Старый 17.11.2009, 16:42   #20
viter.alex
Балуюсь кодами
Профессионал
 
Аватар для viter.alex
 
Регистрация: 09.01.2009
Адрес: Харків, Україна
Сообщений: 1,803
Репутация: 716

icq: 194381182
skype: viter.alex
По умолчанию

Какую команду?
__________________
Лучше день потерять — потом за пять минут долететь!©
viter.alex вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Принтеры в сети HappyUser Работа с сетью в Delphi 0 16.04.2009 22:09
печать страниц в обратном порядке Олекса Microsoft Office Word 4 30.03.2009 09:45
Как узнать количество выданных на печать страниц Bogood Общие вопросы Delphi 3 13.03.2009 18:29
Раскрашивание черно-белых изображений!!! ALEX_RAS Помощь студентам 1 16.05.2008 21:57


09:48.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.