Статьи из блога
Статьи из блога
Отправка документа на печать на разные сетевые принтеры
Рубрика: Вопрос-Ответ, Макросы, Советы и cекреты, Настройка Word
Метки: макросы | печать
Понедельник, 17 августа 2009 г.
Просмотров: 4158
Подписаться на комментарии по RSS
Версия для печати
Метки: макросы | печать
Понедельник, 17 августа 2009 г.
Просмотров: 4158
Подписаться на комментарии по RSS
Версия для печати
Поступил интересный вопрос от Павла. Он спрашивает:
У меня подключено несколько сетевых принтеров. Можно ли с помощью разных кнопок-макросов печатать на разные предопределенные принтера, а не только на принтер по умолчанию?
Мой соавтор Александр Витер предложил воспользоваться методом ActivePrinter, и я набросал небольшой макрос.
Пусть, например, у вас есть сетевой принтер по имени "Полное_Сетевое_Имя_Принтера" (смотрите наименования в настройках печати). Тогда макрос будет следующий:
Public Sub prNet() 'Печать документа из сетевого принтера, установленного не по умолчанию Dim sMyPrinter As String Dim netPrinter As String 'Запоминаем текущий принтер по умолчанию sMyPrinter = Application.ActivePrinter 'Присваиваем переменной имя сетевого принтера netPrinter = "Полное_Сетевое_Имя_Принтера" 'Делаем активным сетевой принтер Application.ActivePrinter = netPrinter 'Печатаем документ с текущими настройками ActiveDocument.PrintOut 'Восстанавливаем принтер по умолчанию Application.ActivePrinter = sMyPrinter End Sub
Сделайте такой же макрос (измените его имя) для других принтеров и выведите кнопки этих макросов на панель инструментов.
Поиск
Рубрики
Подписка
Читают
Обсуждают
страницы
сайты
статистика
Комментариев: 16
Уважаемый Антон, подскажите макрос чтоб назначал каждой букве выделенного текста новый шрифт из 4 -5 мною назначенных, оочень надо.
Уважаемый Чирок, а как вы представляете себе это назначение?
Конечно, это можно сделать, просто если в слове будет не 4-5 букв, а 8, то как должно происходить назначение шрифта для каждой буквы? Да, и если те же 4-5 букв в слове - как должно по-вашему происходить это назначение? Как вы видите эту ситуацию, чтобы ее можно было практически реализовать?
назначать случайно или по порядку - неважно. практическая задача - создать "рукописный" текст принтером. есть 4 шрифта с моим почерком нада их перемешать в выделеном тексте и тогда две рядом стоящие буквы "с" будут отличатся друг от друга
Решил в лоб. Каждой букве выделенного текста назначается свой шрифт из заданных в массиве.
Sub AssignFontForLetter() Dim arFontNames() Dim LoopCounter As Long, i As Integer 'Массив с именами шрифтов arFontNames = Array("Arial", "Times New Roman", "Comic Sans Serif", "Courier New", "Lucida Console") 'Счетчик циклов перебора массива LoopCounter = 1 Do While Selection.Characters.Count LoopCounter For i = 0 To UBound(arFontNames) If Not Selection.Characters(LoopCounter + i) Is Nothing Then _ Selection.Characters(LoopCounter + i).Font.Name = arFontNames(i) Next LoopCounter = LoopCounter + UBound(arFontNames) + 1 Loop End Sub
Супер! Ура! Нечеловеческое вам спасибо.Вполне хватило бы и человеческого.
Только зачем это нужно? Преподаватель придумал?
Предложу еще вариант со случайным выбором шрифта:
Sub AssignRandomFontForLetter() Dim arFontNames() Dim oChar As Range 'Массив с именами шрифтов arFontNames = Array("Arial", "Times New Roman", "Comic Sans Serif", "Courier New", "Lucida Console") 'Инициализация генератора случайных чисел Randomize 'Перебираем все символы в выделении For Each oChar In Selection.Characters 'Генерируем случайное число в диапазоне от 0 до размера массива i = Int(Rnd() * (UBound(arFontNames) + 1)) 'Задаем шрифт очередного символа oChar.Font.Name = arFontNames(i) Next oChar End SubКстати добавлю, что при выделении слова, например, двойным щелком по нему, будет выделен также и стоящий за словом пробел (если слово не заканчивается знаком препинания). И если воспользоваться первым макросом, то в конце выполнения кода может (!) появиться ошибка.
Можно ее исключить, если добавить в код обработчик ошибок:
либо добавить операторы сжатия выделенного диапазона (убрать лишний пробел из выделения в конце слова):
With Selection If Right(.Range, 1) = Chr(32) Then .MoveLeft unit:=wdCharacter, Count:=1, Extend:=wdExtend End If End WithРаботаю простым пожарным, все было хорошо пока не явился господин Шойгу и не возжелал себе армию спасателей - пожарную охрану вывели из МВД и сунули под МЧС, наплодили подструктур и понаставили начальников-армейских отставников!(а они все деревянные)Теперь по всей стране пожарные, как школяры пишут в тетрадках конспекты по 50 - 60!!! листов в день! и ладно если бы в конспектах было что то новое, или полезное. Деревянные начальники ПРОВЕРЯЮТ! тетради(не бай бог мало написано), !!!после отпуска восстанавливать все что пропустил!!! лишают премий и объявляют выговоры. Пробовали писать "под расческу" - не вышло. У меня тут скоро отпуск заканчивается, принтер я уже переделал, чтоб тетрадь развернутая целиком залазила, печатать в ней получилось, дело только за рукописным шрифтом
ваш макрос уже успешно оперирует 5ю шрифтами создаными в фонткреаторе под мой почерк. одного шрифта было недостаточно т.к. в ,например, аббривеатуре СССР три якобы рукописные буквы абсолютно одинаковы, чего, несомненно, в рукописном тексте не бывает
Вот же как бывает!
"Голь на выдумку хитра", как бы не усложняли нашу жизнь.
Боюсь, что будет похоже на почерк не совсем трезвого человека
Покажите хоть скрины того, что получилось. Документы не выкладывайте, т.к. у нас нет ваших шрифтов.
Да, покажите результат - дайте ссылку на скрин.
Напишите, пожалуйста, макрос, котрый распечатовал несколько документов(десятки rtfных файлов)по 2 страницы на листе!!!Заранее спасибо
попробуйте такой макрос. При запуске появится окно для выбора необходимых файлов и затем все эти файлы будут, я надеюсь, распечатаны по две страницы на листе.
Sub PrintMultiplyFiles() Dim i As Integer With Application.FileDialog(msoFileDialogFilePicker) .AllowMultiSelect = True .ButtonName = "Выбрать" .Title = "Выберите файлы для печати" .Filters.Clear: .Filters.Add "Файлы RTF", "*.rtf" If .Show Then For i = 1 To .SelectedItems.Count Application.PrintOut FileName:=.SelectedItems(i), PrintZoomColumn:=2 Next i End If End With End SubЗдравствуйте! Спасибо за макросы с перебором шрифтов. В продолжение темы, не могли бы вы написать макрос, который рандомизирует отступ в начале строки - чтобы текст не выглядел очень ровным слева, что может вызвать подозрение у читающего. Заранее спасибо!
Подскажите, плиииз!!!nакая ситуация, у меня в программе MIKROSOFT OFFICE WORD созданы накладные, там в двух местах надо указать номер накладной, можно ли сделать так, чтобы при распечатывании каждая последующая накладная в графе НОМЕР НАКЛАДНОЙ автоматически увеличивалась на 1???? (от руки тысячами пронумировывать ооочень тяжко) заранее спасибо!!!!