PrintPreviewAndPrintについて。

Question

印刷プレビュー（全画面表示）にバグがあり、下部のオブジェクトが表示されない事象がありました。

このことについては上記のようにマイクロソフトでも把握しているようです。

その回避方法について、
Application.CommandBars.ExecuteMso "PrintPreviewAndPrint"
を使うことを推奨され、使う方向でソースを書いています。
しかし、

Application.Dialogs(xlDialogPrint).Show 2, 1, Page, 1

のように、出力開始ページなどマクロで計算したものをPrintPreviewAndPrintに引き渡したいと思うのです。
しかし、その辺について述べられたものがなく困っております。

すでにyahooでも質問したのですが、回答が返ってこないため、急遽こちらにも質問するところです。
マルチポストは失礼にあたるのですが、それを重々承知の上で質問させていただきます。
申し訳ございません。

Answer 1

もとの質問はこれ？

Excel2016限定なら無理やりやればできないことは無いかもしれない

'参照の追加でUIAutmationClientを追加しておく
Option Explicit
Enum PrintRangeType
    Sheet = 0
    Book = 1
    Selected = 2
End Enum

Private Function FindElementBy _
    (ByVal uia As UIAutomationClient.CUIAutomation8 _
    , ByVal e As UIAutomationClient.IUIAutomationElement _
    , ByVal scope As UIAutomationClient.TreeScope _
    , ByVal propertyId As Long _
    , ByVal v As Variant _
    , ByVal errmsg As String) As UIAutomationClient.IUIAutomationElement
    
    Dim con As UIAutomationClient.IUIAutomationPropertyCondition
    Set con = uia.CreatePropertyCondition(propertyId, v)
    
    Set FindElementBy = e.FindFirst(scope, con)
    If (FindElementBy Is Nothing) Then
        Err.Raise vbObjectError + 512, Description:=errmsg
    End If
End Function

Private Function FindElementsBy _
    (ByVal uia As UIAutomationClient.CUIAutomation8 _
    , ByVal e As UIAutomationClient.IUIAutomationElement _
    , ByVal scope As UIAutomationClient.TreeScope _
    , ByVal propertyId As Long _
    , ByVal v As Variant _
    , ByVal errmsg As String) As UIAutomationClient.IUIAutomationElement()
    
    Dim con As UIAutomationClient.IUIAutomationPropertyCondition
    Set con = uia.CreatePropertyCondition(propertyId, v)
    
    Dim ar As UIAutomationClient.IUIAutomationElementArray
    
    Set ar = e.FindAll(scope, con)
    If (ar.Length = 0) Then
        Err.Raise vbObjectError + 512, Description:=errmsg
    End If
    Dim a() As UIAutomationClient.IUIAutomationElement
    ReDim a(ar.Length - 1)
    
    Dim i As Integer
    For i = 0 To ar.Length - 1
        Set a(i) = ar.GetElement(i)
    Next
    FindElementsBy = a
End Function

Private Function FindElementByHandle(ByVal uia As UIAutomationClient.CUIAutomation8, ByVal e As UIAutomationClient.IUIAutomationElement, ByVal scope As UIAutomationClient.TreeScope, ByVal v As Variant, ByVal errmsg As String) As UIAutomationClient.IUIAutomationElement
    Set FindElementByHandle = FindElementBy(uia, e, scope, UIAutomationClient.UIA_NativeWindowHandlePropertyId, v, errmsg)
End Function

Private Function FindElementByPropetyId(ByVal uia As UIAutomationClient.CUIAutomation8, ByVal e As UIAutomationClient.IUIAutomationElement, ByVal scope As UIAutomationClient.TreeScope, ByVal v As Variant, ByVal errmsg As String) As UIAutomationClient.IUIAutomationElement
    Set FindElementByPropetyId = FindElementBy(uia, e, scope, UIAutomationClient.UIA_PropertyIds.UIA_AutomationIdPropertyId, v, errmsg)
End Function

Private Function FindElementByName(ByVal uia As UIAutomationClient.CUIAutomation8, ByVal e As UIAutomationClient.IUIAutomationElement, ByVal scope As UIAutomationClient.TreeScope, ByVal v As Variant, ByVal errmsg As String) As UIAutomationClient.IUIAutomationElement
    Set FindElementByName = FindElementBy(uia, e, scope, UIAutomationClient.UIA_PropertyIds.UIA_NamePropertyId, v, errmsg)
End Function

Private Function FindElementByClass(ByVal uia As UIAutomationClient.CUIAutomation8, ByVal e As UIAutomationClient.IUIAutomationElement, ByVal scope As UIAutomationClient.TreeScope, ByVal v As Variant, ByVal errmsg As String) As UIAutomationClient.IUIAutomationElement
    Set FindElementByClass = FindElementBy(uia, e, scope, UIAutomationClient.UIA_PropertyIds.UIA_ClassNamePropertyId, v, errmsg)
End Function


Private Sub SetSpinValue(ByRef spins() As UIAutomationClient.IUIAutomationElement, ByVal name As String, ByVal v As String)
    Dim i As Integer
    For i = LBound(spins) To UBound(spins)
        If (spins(i).CurrentName = name) Then
            Dim spin  As UIAutomationClient.IUIAutomationElement
            Set spin = spins(i)
            
            Dim vp As UIAutomationClient.IUIAutomationValuePattern
            Set vp = spin.GetCurrentPattern(UIAutomationClient.UIA_PatternIds.UIA_ValuePatternId)
            Call vp.SetValue(v)
            Exit Sub
        End If
    Next
    Err.Raise vbObjectError + 512, Description:="スピン(" & name & ")が見つかりません"
End Sub

Private Function GetBackstageView(ByVal uia As UIAutomationClient.CUIAutomation8) As UIAutomationClient.IUIAutomationElement
    Application.CommandBars.ExecuteMso "PrintPreviewAndPrint"

    Dim h As LongPtr
    h = Application.ActiveWindow.Hwnd

    Dim root As UIAutomationClient.IUIAutomationElement
    Set root = uia.GetRootElement
    
    Dim eExcel As UIAutomationClient.IUIAutomationElement
    Dim eBackstageView As UIAutomationClient.IUIAutomationElement
    
    Set eExcel = FindElementByHandle(uia, root, TreeScope_Children, h, "エクセルを見つけられませんでした")
    Set GetBackstageView = FindElementByPropetyId(uia, eExcel, TreeScope_Subtree, "BackstageView", "バックステージを見つけられませんでした")
End Function

Public Sub ShowPrintBackstage _
    (Optional ByVal printRange As PrintRangeType = PrintRangeType.Sheet _
    , Optional ByVal fromPage As Integer = -1 _
    , Optional ByVal toPage As Integer = -1 _
    , Optional ByVal copies As Integer = 1 _
    , Optional ByVal printerName As String)
    
    Dim uia As UIAutomationClient.CUIAutomation8
    Set uia = New UIAutomationClient.CUIAutomation8
    
    Dim eBackstageView As UIAutomationClient.IUIAutomationElement
    Set eBackstageView = GetBackstageView(uia)

    Dim timeOut As Date
    timeOut = Now + TimeValue("0:0:5")
    
    On Error Resume Next
    Do

        DoEvents
        Err.Clear
        
        Dim spins() As UIAutomationClient.IUIAutomationElement
        spins = FindElementsBy(uia, eBackstageView, TreeScope_Subtree, UIAutomationClient.UIA_PropertyIds.UIA_ControlTypePropertyId, UIAutomationClient.UIA_ControlTypeIds.UIA_SpinnerControlTypeId, "スピンを見つけられませんでした")
        Call SetSpinValue(spins, "部数", copies)
        Call SetSpinValue(spins, "ページ指定", IIf(fromPage > 0, fromPage, ""))
        Call SetSpinValue(spins, "から", IIf(fromPage > 0, toPage, ""))
    
        If (Now > timeOut And Err.Number <> 0) Then
            On Error GoTo 0
            Err.Raise vbObjectError + 512, Description:="スピンが見つからないか操作できませんでした"
        End If
    Loop While Err.Number <> 0
    On Error GoTo 0

    Dim eRng As UIAutomationClient.IUIAutomationElement
    Set eRng = FindElementByName(uia, eBackstageView, TreeScope_Subtree, "印刷対象", "印刷対象を見つけられません")

    Dim dropdown As UIAutomationClient.IUIAutomationExpandCollapsePattern
    Set dropdown = eRng.GetCurrentPattern(UIAutomationClient.UIA_PatternIds.UIA_ExpandCollapsePatternId)
    dropdown.Expand
    
    Dim items() As UIAutomationClient.IUIAutomationElement
    items = FindElementsBy(uia, eRng, TreeScope_Subtree, UIAutomationClient.UIA_PropertyIds.UIA_ControlTypePropertyId, UIAutomationClient.UIA_ControlTypeIds.UIA_ListItemControlTypeId, "印刷対象の選択項目を見つけられませんでした")
    Dim i As Integer
    i = printRange
    If (UBound(items) >= i) Then
        Dim sel As UIAutomationClient.IUIAutomationSelectionItemPattern
        Set sel = items(i).GetCurrentPattern(UIAutomationClient.UIA_PatternIds.UIA_SelectionItemPatternId)
        sel.Select
    End If
    dropdown.Collapse
End Sub

Public Function GetPageCount() As Integer
    Dim uia As UIAutomationClient.CUIAutomation8
    Set uia = New UIAutomationClient.CUIAutomation8
    
    Dim eBackstageView As UIAutomationClient.IUIAutomationElement
    Set eBackstageView = GetBackstageView(uia)
    
    Dim eCurrentPage As UIAutomationClient.IUIAutomationElement
    Dim eMaxPage  As UIAutomationClient.IUIAutomationElement
    Set eCurrentPage = FindElementByName(uia, eBackstageView, TreeScope_Subtree, "現在のページ", "現在ページが見つかりません")
    
    Dim w As UIAutomationClient.IUIAutomationTreeWalker
    Set w = uia.CreateTreeWalker(uia.CreateTrueCondition)
    Set eMaxPage = w.GetNextSiblingElement(eCurrentPage)
     
    GetPageCount = CInt(Replace(eMaxPage.CurrentName, "/", ""))
End Function

Win8.1+Excel2016でしか確認してません
#Win7+Excel2013では動かなかった

---

個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

Answer 2

まずはありがとうございます。

あまりに長いコードで、絶句、かつ大変にお手間をおかけしたこと心苦しく思います。
まずは御礼まで。

Answer 3

私の技量不足故ではあるのですが、
今書いていただいたソースを読んでいるところなのですが、理解が難しいです。
もしよろしかったらでいいのですが、

1.各ファンクションの目的
2.二つあるサブルーチンの概要

を解説いただくことはできないでしょうか。