Autodesk Inventor macro for Print all drawings

Here is my macro for print all drawings for components for opened drawing. The condition is the same name model and drawing. But this condition can be changed. I tested the macro only on Inventor version 2016.

Function TiskVykresu(CestaVykresu As String, Zavrit As Boolean)
 'Funkce pro tisk výkresu podle jeho velikosti
 Dim oDrgDoc As Inventor.Document
 Dim JmenoDokumentu As String
 ThisApplication.SilentOperation = True
 Set oDrgDoc = ThisApplication.Documents.Open(CestaVykresu)
 JmenoDokumentu = oDrgDoc.DisplayName
 Dim oDrgPrintMgr As DrawingPrintManager
 Set oDrgPrintMgr = oDrgDoc.PrintManager
 Dim JmenoAktualnihoListu As String
 Dim JmenaListu As String
 Dim PocetListu As Long
 PocetListu = oDrgDoc.Sheets.Count
 'Zjištění velikosti aktivního listu
 Dim VelikostListu As String
 Dim VelikostTisku As String
 oDrgPrintMgr.Printer = "\\VFS01\prt_16_chodba_prizemi_primy" 'Nastavit podle svojí tiskárny
 oDrgPrintMgr.PaperSize = kPaperSizeA3 'Přednastavení
 VelikostTisku = "A3" 'Přednastavení
 oDrgPrintMgr.AllColorsAsBlack = True

 oDrgPrintMgr.NumberOfCopies = 1

 oDrgPrintMgr.PrintRange = kPrintAllSheets
 oDrgPrintMgr.Orientation = kPortraitOrientation
 Select Case oDrgDoc.Sheets.Item(1).Size
  Case kA0DrawingSheetSize
   VelikostListu = "A0"
   oDrgPrintMgr.ScaleMode = kPrintBestFitScale
  Case kA1DrawingSheetSize
   VelikostListu = "A1"
   oDrgPrintMgr.ScaleMode = kPrintBestFitScale
  Case kA2DrawingSheetSize
   VelikostListu = "A2"
   oDrgPrintMgr.ScaleMode = kPrintBestFitScale
  Case kA3DrawingSheetSize
   VelikostListu = "A3"
   oDrgPrintMgr.PaperSize = kPaperSizeA3 'Nastavení papíru tiskárny
   VelikostTisku = "A3"
   oDrgPrintMgr.ScaleMode = kPrintFullScale
  Case kA4DrawingSheetSize
   VelikostListu = "A4"
   oDrgPrintMgr.PaperSize = kPaperSizeA4 'Nastavení papíru tiskárny
   VelikostTisku = "A4"
   oDrgPrintMgr.ScaleMode = kPrintFullScale
  Case Else
   VelikostListu = "nestandartní"
 End Select
 ' Zjištění natočení listu a případná změna
 Dim OtoceniListu As String
 If oDrgDoc.ActiveSheet.Orientation = kPortraitPageOrientation Then
  oDrgPrintMgr.Rotate90Degrees = 0
  OtoceniListu = "na výšku"
 Else
  oDrgPrintMgr.Rotate90Degrees = 1
  OtoceniListu = "na šířku"
 End If
 JmenoAktualnihoListu = oDrgDoc.ActiveSheet.Name
 Dim CisloAktivnihoListu As Long
 Dim i As Variant
 'Zjištění čísla aktivního listu
 For i = 1 To PocetListu
  JmenaListu = oDrgDoc.Sheets.Item(i).Name
  If JmenoAktualnihoListu = JmenaListu Then
   CisloAktivnihoListu = i
  End If
 Next
 If Zavrit = True Then
  oDrgDoc.Close
 End If
 ThisApplication.SilentOperation = False
End Function

Sub Prehled_DoplnujicichVykresu()
'Makro pro nalezení zúčastněných modelú a jejich výkresú
 Dim VykesSestavy As Inventor.DrawingDocument
 Dim Dil As Inventor.Document
 Dim Cesta As String
 Dim Jmeno As String
 Dim SeznamVykr As String
 Set VykesSestavy = ThisApplication.ActiveDocument
 PocetDilu = VykesSestavy.AllReferencedDocuments.Count
 Dim PocetVykresu As Integer
 PocetVykresu = 0
 Dim i As Integer
 i = 1
 For Each Dil In VykesSestavy.AllReferencedDocuments 'Opakuje pro každý díl vstupující do výkresu
  Set Dil = VykesSestavy.AllReferencedDocuments.Item(i) 'Načtení dílu
  Jmeno = Dil.DisplayName
  Cesta = Left(Dil.FullDocumentName, Len(Dil.FullDocumentName) - Len(Jmeno)) 'Cseta k soubouru bez jeho názvu
  Jmeno = Left(Jmeno, 4) + ".idw" 'Doplnění přípony výkreesu inventoru
  Cesta = Cesta + Jmeno 'Celá cesta k výkresu
  If Dir$(Cesta) <> "" Then 'Finta jak zjistit jestli soubor existuje
   SeznamVykr = SeznamVykr + Chr(10) + Jmeno
   If i = 1 Then
    Call TiskVykresu(Cesta, False)
   Else
    Call TiskVykresu(Cesta, True)
   End If
   PocetVykresu = PocetVykresu + 1 'Připočtení výkresu pokud existuje
  End If
  i = i + 1
 Next 'Konec načítání jednotlivých dílú výkresu
 MsgBox ("Počet dílú: " & PocetDilu & Chr(10) & "z toho výkresú: " & PocetVykresu & Chr(10) & SeznamVykr) 'Info co jsme vyčetli o souborech výkresu
End Sub