Просматривают:
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
|
|