Option Compare Database
Option Explicit

Private prAcrobat As Object 'Acrobat.Application
Private prAcrobatDoc As Object
Private prNoAcrobatMsgIsShown As Boolean

Function GetAcrobat() As Object
    If prAcrobat Is Nothing Then
        Set prAcrobat = CreateObject("AcroExch.App")
        prAcrobat.Show
    End If
    Set GetAcrobat = prAcrobat
    If (prAcrobat Is Nothing) And Not prNoAcrobatMsgIsShown Then
      prNoAcrobatMsgIsShown = True
      MsgBox "Acrobat Reader не установлен на данной машине. Просмотр и печать файлов в формате PDF невозможны. Установите Acrobat Reader!", vbCritical
    End If
End Function

Function GetAcrobatDoc() As Object
    If prAcrobat Is Nothing Then GetAcrobat
    If prAcrobatDoc Is Nothing Then
        Set prAcrobatDoc = CreateObject("AcroExch.AVDoc")
        prAcrobatDoc.BringToFront
    End If
    Set GetAcrobatDoc = prAcrobatDoc
    If (GetAcrobatDoc Is Nothing) And Not prNoAcrobatMsgIsShown Then
      prNoAcrobatMsgIsShown = True
      MsgBox "Не могу создать документ PDF. Просмотр и печать файлов в формате PDF невозможны!", vbCritical
    End If
End Function

Public Sub ResetAcrobat()
    If Not prAcrobatDoc Is Nothing Then
      On Error Resume Next
      prAcrobatDoc.Close True
      Set prAcrobatDoc = Nothing
    End If
    If Not prAcrobat Is Nothing Then
      On Error Resume Next
      prAcrobat.CloseAllDocs
      prAcrobat.Exit
      Set prAcrobat = Nothing
    End If
End Sub

Public Sub ShowViaAcrobat(aFile As String)
  Dim Acrobat As Object
  Dim AcrobatDoc As Object
'  Dim Acrobat As Acrobat.CAcroApp
  Set Acrobat = GetAcrobat()
  Set AcrobatDoc = GetAcrobatDoc()
  If AcrobatDoc Is Nothing Then Exit Sub
  On Error GoTo ErrorOpen
  If AcrobatDoc.IsValid Then AcrobatDoc.Close True
  DoEvents
  AcrobatDoc.Open aFile, aFile
  DoEvents
  Acrobat.Show
  DoEvents
  Acrobat.Restore  1 
  DoEvents
Exit Sub
ErrorOpen:
  On Error Resume Next
  ResetAcrobat
End Sub

Public Function PrintViaAcrobat(aFile As String, Optional ShowWindow As Boolean = True) As Boolean
  Dim Acrobat As Object
  Dim AcrobatDoc As Object
  Dim pn As Long
  
  Set Acrobat = GetAcrobat()
  Set AcrobatDoc = GetAcrobatDoc()
  If AcrobatDoc Is Nothing Then Exit Function
  On Error GoTo ErrorOpen
  If AcrobatDoc.IsValid Then AcrobatDoc.Close True
  DoEvents
  AcrobatDoc.Open aFile, aFile
  DoEvents
  If ShowWindow Then
    Acrobat.Show
    DoEvents
    Acrobat.Restore  1 
    DoEvents
    AcrobatDoc.BringToFront
    DoEvents
  End If
  pn = AcrobatDoc.GetPDDoc.GetNumPages
  DoEvents
  PrintViaAcrobat = AcrobatDoc.PrintPages( 0 , pn -  1 ,  0 ,  1 ,  1 )
  DoEvents
Exit Function
ErrorOpen:
  On Error Resume Next
  ResetAcrobat
End Function