Народ, привет!

В просторах инета нашел макрос, позволяющий указать рамкой что будем печатать - очень удобно. В макросе есть анализ слоев на 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

И чего тебя удивляет? В коде слои Master Page вообще не анализируется на Printable.
Цитата:

То же самое надо сделать для ActiveDocument.Pages(0)
Замени p1 на ActiveDocument.Pages(0)

Только лучше всего создавать не новую страницу в документе, а новый документ и из него печатать.
И обращение делать к ним Documents(1) и Documents(2)

И где остальной код? может весь макрос выложишь? У тебя создается объект M1, но он нигде в приведенном коде не используется.

Уважаемый, 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

Пока проблему решал так:
В нужных местах вызывал макросы:

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 - то добавляется в шаблоны.

vavalexus Может просто в 13 версии синтаксис изменился. Просто вручную запиши макрос с операциями над слоями и посмотри какой код сгенерирует corel.

Еще есть проблема с русификаторами. Я столкнулся еще с этим в 5 3дМаксе. Русификатор просто заменял английские термины на русские по словарю (все какие находил). После чего половина программы, а точнее та часть которая была на скриптах, просто отваливалась и постоянно выдавалась ошибка 'Scrypt Error', демонстрировался код скрипта, в котором все операторы били заменены русскими терминами. После чего я русские версии вообще не устанавливаю)))

Цитата:
Я русские тоже терпеть не могу, дома весь софт английский, но на работе лицуха, ниче не поделаешь.

А с этим не получится?

К сожалению, в 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
Но что-то видно не то.
Заранее спасибо!

Цитата:

Так вроде должно работать
Тока после этой операции необходимо слои Мастер Пейдж сделать Принтейбл = Фальш

Я вообще в кореле макросы не пишу. В свое время прогал на ВБА. Просто лень разбираться как в кореле пойдет процесс взаимодействия между двумя документами)))

По хорошему, надо бы индексы слоев МастерПейдж заносить в массив и потом в конце программы снова восстанавливать Принтейбл=Тру для соответствующих слоев.

Цитата:

End If? Expected expression - просто Else?
Цитата:
А это для чего?
Спасибо Вам за помощь и сорри за вопросы, буду учить VBA. Но с этим очень прошу помогите. Если вы с киева, с меня пиво :)

Сейчас то работает?
И посмотри я там еще синим написал.)))

Ой, спросил откуда, а под аватаром не посмотрел :(
Убежал, буду завтра... Спасибо!

vavalexusДа, просто Else)))) Цикл в конце возвращает значения Принтбл у слоев МастерПейдж в исходные значения из сохраненных в массиве. Его ставить надо после того как все отпечаталось.