Print Settings w/ Macro

Been a while and havent used CD.

Curious if there's a Macro to speed up the process.

I'd like to:

1. Select all objects
2. Goto Print Preview
3. Fit to Page
4. print Black & White or Greyscale

Something simple than clicking a preset or manually selecting Selected Objects & Fit to Page.
Would like to assign a keystroke to automatically do this. Maybe be able to modify code afterwards.

Possible?

Thanks all!

[runflacruiser]

Hi.
I don't see anything that would take us straight to print preview but maybe we can make our own.

Select shape and run macro.
Macro would set visibility of all other items on page and place your selected item in the middle, show printable area, and set size.
Upon a keystroke or macro button to continue it would print the item as you have it placed and then return everything back as it was.

-John

[runflacruiser]

..yes I know this post is old but I though it could be handy.

Here's the script I came up with.
I am running into 1 problem.
I want a single undo in the area of line:

'manually size it or whatever before final printing

Yea. I could probably copy the original shape and re-paste or just make a duplicate of it but this has got me wondering.

Any ideas why the begin and end command group in that area is not acting as a single undo?

Here's the code. Make a selection and run, Press esc to cancel, shift to print. (actual printing code is commented out)

Option Explicit
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Const VK_ESCAPE = &H1B
Private Const VK_SHIFT = &H10


Sub readyTheQuickPrint()

    Dim s As Shape, srAll As ShapeRange, srTarget As ShapeRange
    Dim srPageBack As New ShapeRange, sPageBack As Shape
    Dim lCurrent As Layer, lTemp As Layer
    Dim shRect1 As Shape, shRect2 As Shape
    Dim ph As Double, pw As Double
    
    'you must have an item selected that you want printed.
    If ActiveSelection.Shapes.Count = 0 Then Exit Sub
    
    ResetEscStatus
    
    ActiveDocument.BeginCommandGroup "Ready The Quick Print"
    ph = ActivePage.SizeHeight: pw = ActivePage.SizeWidth
    
    'create temp layer and get our shapes
    '--select shape: srTarget
    '--everything else: srAll
    Set lCurrent = ActiveLayer
    Set lTemp = ActivePage.CreateLayer("lTemp")
    Set srAll = ActivePage.Shapes.All
    srAll.RemoveRange ActiveSelection.Shapes.All
    Set srTarget = ActiveSelectionRange
    
    'everything else to a new temp layer locked and invisible.
    srAll.MoveToLayer lTemp
    lTemp.Visible = False
    lTemp.Shapes.All.Lock
    
    'create a couple background simulation shapes.
    'Good idea in case the user doesn't have page border or printable area showing.
    Set shRect2 = lCurrent.CreateRectangle2(0, 0, pw, ph)
    Set shRect1 = shRect2.Duplicate(0.25, -0.25)
    shRect1.Fill.UniformColor.CMYKAssign 0, 0, 0, 60
    shRect2.Fill.UniformColor.CMYKAssign 0, 0, 0, 0
    shRect1.OrderBackOne
    srPageBack.Add shRect1: srPageBack.Add shRect2
    Set sPageBack = srPageBack.Group
    sPageBack.OrderToBack
    sPageBack.Locked = True
    
    'move our target shape on to the simulated page.
    With srTarget
        ActiveDocument.ReferencePoint = cdrTopLeft
        .SetPosition 0, ph
        .SetSize pw
    End With
    
    ActiveWindow.ActiveView.ToFitAllObjects
    
    ActiveDocument.EndCommandGroup
    
    'frmMain.Show vbModeless
    ActiveDocument.BeginCommandGroup "Quick Print"
    Do While 1 = 1
        DoEvents
        'manually size it or whatever before final printing
        
        If IsEscPressed() Then
            
            GoTo exitQP:
        End If
        If IsShiftPressed() Then
            
            GoTo exitQP:
        End If
    Loop


printQP:
    'quickPrint 'print it
    ActiveDocument.EndCommandGroup
    ActiveDocument.Undo 2
    End
exitQP:
    ActiveDocument.EndCommandGroup
    ActiveDocument.Undo 2

End Sub

Sub quickPrint()

    ColorManager.PreservePureBlack = True 'optional 1
    With ActiveDocument.PrintSettings
        .PrintRange = prnSelection
        .Layout.Placement = prnPlaceAsInDocument
    End With
    ActiveDocument.PrintOut
    ColorManager.PreservePureBlack = False 'optional 1: put it back
    ActiveDocument.Undo

End Sub

Public Function ResetEscStatus(Optional nada As Boolean) As Boolean
    GetAsyncKeyState VK_ESCAPE
    ResetEscStatus = True
End Function

Public Function ResetShiftStatus(Optional nada As Boolean) As Boolean
    GetAsyncKeyState VK_SHIFT
    ResetShiftStatus = True
End Function

Public Function IsEscPressed(Optional Ask As Boolean = True) As Boolean
    Dim b As Boolean
    b = (GetAsyncKeyState(VK_ESCAPE) <> 0)
    If b And Ask Then
        If MsgBox("Do you want to abort quick print?", vbCritical + vbYesNo, "GDG Quick Print") = vbNo Then
            b = False
        End If
    End If
    IsEscPressed = b
End Function

Public Function IsShiftPressed(Optional Ask As Boolean = True) As Boolean
    Dim b As Boolean
    b = (GetAsyncKeyState(VK_SHIFT) <> 0)
    If b And Ask Then
        If MsgBox("Do you want print now?", vbCritical + vbYesNo, "GDG Quick Print") = vbNo Then
            b = False
        End If
    End If
    IsShiftPressed = b
End Function

-John

[runflacruiser]

Hi.
Here's another way.
Basically copying all shapes hiding, and then creating a temp duplicate shape of target selection to go to the simulated print preview.

The reason I was trying with the above script was to put the document back in the exact same place. This one does but leaves the undo-able actions.

Try it.
Make a selection, run macro.
Move, size, at will on simulated print preview area. (optional)
Press return on your keyboard to print or esc to cancel.

Option Explicit
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Const VK_ESCAPE = &H1B
Private Const VK_RETURN = &HD


Sub readyTheQuickPrint()

    Dim s As Shape, srAll As ShapeRange, srTarget As ShapeRange
    Dim srPageBack As New ShapeRange, sPageBack As Shape
    Dim lCurrent As Layer, ltemp As Layer
    Dim shRect1 As Shape, shRect2 As Shape
    Dim ph As Double, pw As Double
    
    'you must have an item selected that you want printed.
    If ActiveSelection.Shapes.Count = 0 Then Exit Sub
    
    ResetKeyStatus
    
    ActiveDocument.BeginCommandGroup "Ready The Quick Print"
    ph = ActivePage.SizeHeight: pw = ActivePage.SizeWidth
    
    'create temp layer and get our shapes
    '--select shape: srTarget
    '--everything else: srAll
    Set lCurrent = ActiveLayer
    Set ltemp = ActivePage.CreateLayer("lTemp")
    Set srAll = ActivePage.Shapes.All
    Set srTarget = ActiveSelectionRange.Duplicate
    
    'everything else to a new temp layer locked and invisible.
    srAll.MoveToLayer ltemp
    ltemp.Visible = False
    ltemp.Shapes.All.Lock
    
    'create a couple background simulation shapes.
    'Good idea in case the user doesn't have page border or printable area showing.
    Set shRect2 = lCurrent.CreateRectangle2(0, 0, pw, ph)
    Set shRect1 = shRect2.Duplicate(0.25, -0.25)
    shRect1.Fill.UniformColor.CMYKAssign 0, 0, 0, 60
    shRect2.Fill.UniformColor.CMYKAssign 0, 0, 0, 0
    shRect1.OrderBackOne
    srPageBack.Add shRect1: srPageBack.Add shRect2
    Set sPageBack = srPageBack.Group
    sPageBack.OrderToBack
    sPageBack.Locked = True
    
    'move our target shape on to the simulated page.
    With srTarget
        ActiveDocument.ReferencePoint = cdrTopLeft
        .SetPosition 0, ph
        .SetSize pw
    End With
    
    ActiveWindow.ActiveView.ToFitAllObjects
    
    ActiveDocument.EndCommandGroup
    
    Do While 1 = 1
        DoEvents
        'manually size it or whatever before final printing
        '..................................................
        '..................................................
        '..................................................
        If IsEscPressed(False) Then
            GoTo exitQP: 'exit loop and go to exit
        End If
        If IsReturnPressed(False) Then
            Exit Do 'print it
        End If
    Loop


'-------------
    'quickPrint 'print it (uncomment to do the actual printing)
'-------------


exitQP:

returnOriginals:
    ltemp.Visible = True
    ltemp.Shapes.All.Unlock
    srTarget.Delete
    sPageBack.Locked = False
    sPageBack.Delete
    ActiveWindow.ActiveView.ZoomOut
    
End Sub

Sub quickPrint()

    ColorManager.PreservePureBlack = True 'optional 1
    With ActiveDocument.PrintSettings
        .PrintRange = prnSelection
        .Layout.Placement = prnPlaceAsInDocument
    End With
    ActiveDocument.PrintOut
    ColorManager.PreservePureBlack = False 'optional 1: put it back

End Sub

Public Function ResetKeyStatus(Optional nada As Boolean) As Boolean
    GetAsyncKeyState VK_ESCAPE
    GetAsyncKeyState VK_RETURN
    ResetKeyStatus = True
End Function

Public Function IsEscPressed(Optional Ask As Boolean = True) As Boolean
    Dim b As Boolean
    b = (GetAsyncKeyState(VK_ESCAPE) <> 0)
    If b And Ask Then
        If MsgBox("Do you want to abort quick print?", vbCritical + vbYesNo, "GDG Quick Print") = vbNo Then
            b = False
        End If
    End If
    IsEscPressed = b
End Function

Public Function IsReturnPressed(Optional Ask As Boolean = True) As Boolean
    Dim b As Boolean
    b = (GetAsyncKeyState(VK_RETURN) <> 0)
    If b And Ask Then
        
        If MsgBox("Do you want print now?", vbCritical + vbYesNo, "GDG Quick Print") = vbNo Then
            b = False
        End If
    End If
    IsReturnPressed = b
End Function

-John

[runflacruiser]

Hi.
Why do I get an error on the above code here.
After I click debug and then play then macro continues to run correctly.
Alsop if I hover the mouse over the yellow highlighted error in the vba editor the focus shifts to Draw.

-John

[runflacruiser]

Anyone ideas?