Просматривают:
1 Анонимно
Print Selection |
||
|
||
---|---|---|
Новичок
Присоединился:
2010/6/21 15:09 Сообщений: 11
|
Народ, привет!
В просторах инета нашел макрос, позволяющий указать рамкой что будем печатать - очень удобно. В макросе есть анализ слоев на printable - так вот, почему то этот анализ работает только для основной страницы, а для страницы шаблона, все слоя, даже если они не printable, все равно печатаются. Если все слои с мастер-страницы перенести в основную страницу, то видимость обрабатывается корректно. Как побороть, чтобы не переносить? Заранее большое спасибо! Ниже код. Sub PrintView() ' ' Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double Dim dx As Double, dy As Double Dim doc As Document Dim Shift As Long Dim b As Boolean Dim l1 As Layer Dim s1 As Shape, s2 As Shape Dim DesPrnSettings As PrintSettings Dim DefPage As Page, p2 As Page, p1 As Page Dim DefView As View Set doc = ActiveDocument Set p1 = doc.ActivePage 'Set M1 = doc.MasterPage doc.BeginCommandGroup "Print View" 'Select highest layer Set l1 = p1.CreateLayer("***Print_View_TEMP***" l1.MoveAbove p1.Layers(1) p1.Layers(1).Activate ' Esc to cancel... b = False While Not b ' Rectangular frame... b = doc.GetUserArea(x1, y1, x2, y2, Shift, 10, False, cdrCursorWinCross) If Not b Then Set s1 = ActiveLayer.CreateRectangle(x1, y1, x2, y2) 'no outline s1.Outline.Type = cdrNoOutline s1.Name = "DruckLinse" 'Application.Optimization = True Set p2 = doc.InsertPagesEx(1, False, ActivePage.Index, 8.267717, 11.692913) For i = 1 To p1.Layers.Count If p1.Layers(i).Printable = True Then p1.Layers(i).Shapes.All.Copy p2.Layers(i).Paste End If Next i s1.Delete ActiveLayer.Master = False p2.Layers(1).Activate Set s1 = p2.FindShape("DruckLinse" With s1.CreateLens(cdrLensMagnify, 1#).Lens .RemoveFace = False .Freeze End With ' selected top level group object that contains the lens Set s2 = s1.ParentGroup ' cut object from page s2.Cut ' store page and view for returning to original view afterwards Set DefPage = doc.ActivePage Set DefView = doc.Views.AddActiveView("VB_PrintView" ' add new page at the end of document doc.InsertPages 1, False, ActiveDocument.Pages.Count 'insert cut object (lens) to new page ActivePage.ActiveLayer.Paste 'center object(s) on page x1 = ActivePage.CenterX y1 = ActivePage.CenterY doc.ReferencePoint = cdrCenter dx = x1 - ActiveSelection.PositionX dy = y1 - ActiveSelection.PositionY ActiveSelection.Move dx, dy ' Resize page to fit selected view box ActivePage.SetSize ActiveSelection.SizeWidth, ActiveSelection.SizeHeight ' Print out the selected page on default printer Set DesPrnSettings = doc.PrintSettings With DesPrnSettings .PrintRange = prnCurrentPage End With 'MsgBox DesPrnSettings.Printer.Type 'Print file runPrint = doc.PrintSettings.ShowDialog If runPrint = True Then doc.PrintOut End If 'Debug: MsgBox "Druck wьrde jetzt erfolgen", vbInformation, "Ansicht drucken" ' Delete Page ActivePage.Delete DefPage.Activate DefView.Activate doc.Views.Item("VB_PrintView".Delete p2.Delete l1.Delete p1.Activate Application.Optimization = False Application.Refresh doc.EndCommandGroup End End If Wend End Sub
Опубликовано: 2010/6/21 15:18
|
|
|
Re: Print Selection |
|
---|---|---|
Пользователь 1 уровня
Присоединился:
2010/5/13 13:56 Откуда Московская обл.
Сообщений: 274
|
И чего тебя удивляет? В коде слои Master Page вообще не анализируется на Printable.
Цитата: vavalexus пишет: То же самое надо сделать для ActiveDocument.Pages(0) Замени p1 на ActiveDocument.Pages(0) Только лучше всего создавать не новую страницу в документе, а новый документ и из него печатать. И обращение делать к ним Documents(1) и Documents(2) И где остальной код? может весь макрос выложишь? У тебя создается объект M1, но он нигде в приведенном коде не используется.
Опубликовано: 2010/6/22 10:37
Edited by MAPUTO on 22/06/2010 10:52:12
Edited by MAPUTO on 22/06/2010 10:57:09 |
|
_________________
Corel FOREWER!!!!!!!!!!!! |
||
|
Re: Print Selection |
|
---|---|---|
Новичок
Присоединился:
2010/6/21 15:09 Сообщений: 11
|
Уважаемый, Maputo
К сожалению, в VBA я только на уровне "метода тыка". Если Вас не затруднит, напишите, пожалуйста. Пока добавил Dim DefPage As Page, p2 As Page, p1 As Page, m1 As Page Set m1 = doc.Pages(0) For j = 1 To m1.Layers.Count If m1.Layers(j).Printable = True Then m1.Layers(j).Shapes.All.Copy p2.Layers(j).Paste End If Next j Но что-то видно не то. Заранее спасибо! Да m1 это моя самодеятельность была. По поводу другого документа я был бы не против, но сам не осилю :( Вот весь код: Sub PrintView() ' ' Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double Dim dx As Double, dy As Double Dim doc As Document Dim Shift As Long Dim b As Boolean Dim l1 As Layer Dim s1 As Shape, s2 As Shape Dim DesPrnSettings As PrintSettings Dim DefPage As Page, p2 As Page, p1 As Page Dim DefView As View Set doc = ActiveDocument Set p1 = doc.ActivePage doc.BeginCommandGroup "Print View" 'Select highest layer Set l1 = p1.CreateLayer("***Print_View_TEMP***") l1.MoveAbove p1.Layers(1) p1.Layers(1).Activate ' Esc to cancel... b = False While Not b ' Rectangular frame... b = doc.GetUserArea(x1, y1, x2, y2, Shift, 10, False, cdrCursorWinCross) If Not b Then Set s1 = ActiveLayer.CreateRectangle(x1, y1, x2, y2) 'Set s1 = ActiveLayer.CreateRectangle(-2.188031, 7.822047, 4.103465, 3.962047) 'no outline s1.Outline.Type = cdrNoOutline s1.Name = "DruckLinse" 'Application.Optimization = True Set p2 = doc.InsertPagesEx(1, False, ActivePage.Index, 8.267717, 11.692913) For i = 1 To p1.Layers.Count If p1.Layers(i).Printable = True Then p1.Layers(i).Shapes.All.Copy p2.Layers(i).Paste End If Next i s1.Delete ActiveLayer.Master = False p2.Layers(1).Activate Set s1 = p2.FindShape("DruckLinse") With s1.CreateLens(cdrLensMagnify, 1#).Lens .RemoveFace = False .Freeze End With ' selected top level group object that contains the lens Set s2 = s1.ParentGroup ' cut object from page s2.Cut ' store page and view for returning to original view afterwards Set DefPage = doc.ActivePage Set DefView = doc.Views.AddActiveView("VB_PrintView") ' add new page at the end of document doc.InsertPages 1, False, ActiveDocument.Pages.Count 'insert cut object (lens) to new page ActivePage.ActiveLayer.Paste 'center object(s) on page x1 = ActivePage.CenterX y1 = ActivePage.CenterY doc.ReferencePoint = cdrCenter dx = x1 - ActiveSelection.PositionX dy = y1 - ActiveSelection.PositionY ActiveSelection.Move dx, dy ' Resize page to fit selected view box ActivePage.SetSize ActiveSelection.SizeWidth, ActiveSelection.SizeHeight ' Print out the selected page on default printer Set DesPrnSettings = doc.PrintSettings With DesPrnSettings .PrintRange = prnCurrentPage End With 'MsgBox DesPrnSettings.Printer.Type 'Print file runPrint = doc.PrintSettings.ShowDialog If runPrint = True Then doc.PrintOut End If 'Debug: MsgBox "Druck wьrde jetzt erfolgen", vbInformation, "Ansicht drucken" ' Delete Page ActivePage.Delete DefPage.Activate DefView.Activate doc.Views.Item("VB_PrintView").Delete p2.Delete l1.Delete p1.Activate Application.Optimization = False Application.Refresh doc.EndCommandGroup End End If Wend End Sub
Опубликовано: 2010/6/22 11:30
|
|
|
Re: Print Selection |
|
---|---|---|
Новичок
Присоединился:
2010/6/21 15:09 Сообщений: 11
|
Пока проблему решал так:
В нужных местах вызывал макросы: Sub MasterFalse() ActivePage.Layers("Test".Master = False . . End Sub Sub MasterTrue() ActivePage.Layers("Test".Master = True . . End Sub Но сталкнулся с проблемой. У меня 12 корел EN, и лицензия X3 Rus. Так вот, на EN эти макросы по MASTER=TRUE/FALSE работают, а на X3 - слой вне диапазона. Если автозаписываем макрос в X3 по убиранию слоя из MASTER, потом делаем UNDO и пытаемся запустить - то вылетает ошибка - слой вне диапазона. Код правильный, на 12 работает. Подозрение, что это косяк локализации. Слои называются Слой-Шаблон Test. VBA не понимает имя? Если написать ActiveDocument.Pages(0).Layers("Test".Master = False - пустой слой убирается из шаблонов, а ActiveDocument.Pages(0).Layers("Test".Master = True - добавляется. Но стоит в этом слое что-то нарисовать, при выполнении команды ActiveDocument.Pages(0).Layers("Test".Master = False происходит подвисание корела. Если руками перевести, а потом ActiveDocument.Pages(0).Layers("Test".Master = True - то добавляется в шаблоны.
Опубликовано: 2010/6/22 11:42
Edited by vavalexus on 22/06/2010 12:56:32
|
|
|
Re: Print Selection |
|
---|---|---|
Пользователь 1 уровня
Присоединился:
2010/5/13 13:56 Откуда Московская обл.
Сообщений: 274
|
vavalexus Может просто в 13 версии синтаксис изменился. Просто вручную запиши макрос с операциями над слоями и посмотри какой код сгенерирует corel.
Еще есть проблема с русификаторами. Я столкнулся еще с этим в 5 3дМаксе. Русификатор просто заменял английские термины на русские по словарю (все какие находил). После чего половина программы, а точнее та часть которая была на скриптах, просто отваливалась и постоянно выдавалась ошибка 'Scrypt Error', демонстрировался код скрипта, в котором все операторы били заменены русскими терминами. После чего я русские версии вообще не устанавливаю)))
Опубликовано: 2010/6/22 13:32
|
|
_________________
Corel FOREWER!!!!!!!!!!!! |
||
|
Re: Print Selection |
|
---|---|---|
Новичок
Присоединился:
2010/6/21 15:09 Сообщений: 11
|
Цитата:
MAPUTO пишет: Я русские тоже терпеть не могу, дома весь софт английский, но на работе лицуха, ниче не поделаешь. А с этим не получится? К сожалению, в VBA я только на уровне "метода тыка". Если Вас не затруднит, напишите, пожалуйста. Пока добавил Dim DefPage As Page, p2 As Page, p1 As Page, m1 As Page Set m1 = doc.Pages(0) For j = 1 To m1.Layers.Count If m1.Layers(j).Printable = True Then m1.Layers(j).Shapes.All.Copy p2.Layers(j).Paste End If Next j Но что-то видно не то. Заранее спасибо!
Опубликовано: 2010/6/22 16:19
|
|
|
Re: Print Selection |
|
---|---|---|
Пользователь 1 уровня
Присоединился:
2010/5/13 13:56 Откуда Московская обл.
Сообщений: 274
|
Цитата:
vavalexus пишет: Так вроде должно работать Тока после этой операции необходимо слои Мастер Пейдж сделать Принтейбл = Фальш Я вообще в кореле макросы не пишу. В свое время прогал на ВБА. Просто лень разбираться как в кореле пойдет процесс взаимодействия между двумя документами))) По хорошему, надо бы индексы слоев МастерПейдж заносить в массив и потом в конце программы снова восстанавливать Принтейбл=Тру для соответствующих слоев. Цитата:
Опубликовано: 2010/6/22 17:03
Edited by MAPUTO on 22/06/2010 17:21:26
Edited by MAPUTO on 22/06/2010 17:23:14 Edited by MAPUTO on 23/06/2010 0:43:23 |
|
_________________
Corel FOREWER!!!!!!!!!!!! |
||
|
|
Re: Print Selection |
|
---|---|---|
Новичок
Присоединился:
2010/6/21 15:09 Сообщений: 11
|
End If? Expected expression - просто Else?
Цитата: MAPUTO пишет: А это для чего? Спасибо Вам за помощь и сорри за вопросы, буду учить VBA. Но с этим очень прошу помогите. Если вы с киева, с меня пиво :)
Опубликовано: 2010/6/22 17:23
Edited by vavalexus on 22/06/2010 17:40:25
|
|
|
Re: Print Selection |
|
---|---|---|
Пользователь 1 уровня
Присоединился:
2010/5/13 13:56 Откуда Московская обл.
Сообщений: 274
|
Сейчас то работает?
И посмотри я там еще синим написал.)))
Опубликовано: 2010/6/22 17:27
|
|
_________________
Corel FOREWER!!!!!!!!!!!! |
||
|
Re: Print Selection |
|
---|---|---|
Новичок
Присоединился:
2010/6/21 15:09 Сообщений: 11
|
Ой, спросил откуда, а под аватаром не посмотрел :(
Убежал, буду завтра... Спасибо!
Опубликовано: 2010/6/22 17:42
|
|
|
Re: Print Selection |
|
---|---|---|
Пользователь 1 уровня
Присоединился:
2010/5/13 13:56 Откуда Московская обл.
Сообщений: 274
|
vavalexusДа, просто Else)))) Цикл в конце возвращает значения Принтбл у слоев МастерПейдж в исходные значения из сохраненных в массиве. Его ставить надо после того как все отпечаталось.
Опубликовано: 2010/6/22 20:10
|
|
_________________
Corel FOREWER!!!!!!!!!!!! |
||