V-Форум / Corel VBA / Тема: Print Selection

Re: Print Selection

 22/06/2010 20:10:26 #Link

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

Re: Print Selection

 23/06/2010 11:06:38 #Link

Не получается.

Запускаем, получаем ошибку в строке
MPlayers(j) = False: Subscript out of range
Убираем эту строку, получаем ошибку в строке
MPlayers(j) = True: Subscript out of range
Убираем эту строку, получаем ошибку в строке
p2.Layers(j).Paste: method 'Paste' of object 'iDrawLayer' faild.

Убираем весь цикл - работает как раньше, анализируя принтабл на странице, но вставляя все с мастер-страницы, в независимости от значения принтабл.


Вот код:
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, m1 As Page
Dim MPlayers() As Boolean
Dim DefView As View


Set doc = ActiveDocument
Set p1 = doc.ActivePage
Set m1 = doc.Pages(0)


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

For j = 1 To m1.Layers.Count
If m1.Layers(j).Printable = True Then
m1.Layers(j).Shapes.All.Copy
p2.Layers(j).Paste
m1.Layers(j).Printable = False
MPlayers(j) = True
Else
MPlayers(j) = False
End If

Next j


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
For j = 1 To m1.Layers.Count
m1.Layers(j).Printable = MPlayers(j)
Next j
Wend
End Sub

Re: Print Selection

 23/06/2010 11:48:50 #Link

Поробуй так:
Цитата:

Re: Print Selection

 23/06/2010 11:57:00 #Link

p2.Layers(j).Paste - слой вне диапазона

Re: Print Selection

 23/06/2010 12:18:57 #Link

Есть еще одна проблемка))) Номера слоев будут совпадать и все перемешается. Можно попробовать В цикле j = 1 to x в номера слоев добавлять последнее значение i.

m1.Layers(j).Shapes.All.Copy
p2.Layers(j+i).Paste
m1.Layers(j).Printable = False

Re: Print Selection

 23/06/2010 12:25:30 #Link

то же самое, слой вне диапазона.

Re: Print Selection

 23/06/2010 15:21:41 #Link

m1.Layers(j).Shapes.All.Copy
p2.Layers(p2.Layers.Count).Paste
m1.Layers(j).Printable = False

Так все вставляется в верхний слой. Иначе необходимо перед вставкой создавать дополнительные слои))) К сожалению не могу проверить - у меня функции Copy/Paste отвалились в кореле))) Но ошибки больше не выдает программа.

Re: Print Selection

 23/06/2010 17:34:07 #Link

А у вас работает?
У меня пишет method 'Paste' of object 'iDrawLayer' faild.

Re: Print Selection

 23/06/2010 17:37:34 #Link

есть .CopyToLayer спецом для копирования между слоями

m1.Layers(j).Shapes.All.CopyToLayer p2.Layers.Top
m1.Layers(j).Printable = False

Re: Print Selection

 23/06/2010 17:48:05 #Link

Аналогично.
Проще вcего было бы снять галку MASTER с нужных слоев (их строго фиксированное кол-во), напечатать, потом поставить MASTER назад. Тогда не нужен был бы этот цикл.

Как я уже писал:
Если написать ActiveDocument.Pages(0).Layers("Test").Master = False - ПУСТОЙ слой убирается из шаблонов, а ActiveDocument.Pages(0).Layers("Test".Master = True - добавляется. Но стоит в этом слое что-то нарисовать, при выполнении команды ActiveDocument.Pages(0).Layers("Test").Master = False происходит подвисание корела. В 12 EN кореле отлично работает ActivePage.Layers("Test").Master = False/True.

« 1 (2) 3 »