macro AutoPrint - Autodesk Inventor 2013

This macro print current document or only current list. Macro configure print machine according to current list' dimension.

Public Sub TiskDleVelikosti()
On Error Resume Next
If ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then

If Err.Number = 91 Then
MsgBox "Musí být otevřen výkres"
Exit Sub
End If

Dim oDrgDoc As DrawingDocument
Dim JmenoDokumentu As String
Set oDrgDoc = ThisApplication.ActiveDocument
JmenoDokumentu = oDrgDoc.DisplayName
' Set reference to drawing print manager
' DrawingPrintManager has more options than PrintManager
' as it's specific to drawing document
Dim oDrgPrintMgr As DrawingPrintManager
Set oDrgPrintMgr = oDrgDoc.PrintManager
Dim JmenoAktualnihoListu As String
Dim JmenaListu As String
Dim PocetListu As Long
PocetListu = oDrgDoc.Sheets.Count
Dim ListyKTisku As Boolean
ListyKTisku = False

If PocetListu > 1 Then
If MsgBox("Tisknout všechny listy?", vbYesNo + vbQuestion) = vbYes Then
ListyKTisku = True
End If
End If

' Zjištění velikosti aktivního listu
Dim VelikostListu As String
Dim VelikostTisku As String
oDrgPrintMgr.PaperSize = kPaperSizeA3 'Přednastavení
VelikostTisku = "A3" 'Přednastavení
' Set the printer name
' comment this line to use default printer or assign another one
oDrgPrintMgr.Printer = "\\VFS01\Canon iR3025 PCL55"
'Nastavení měřítka, papíru, které listy, orientace listu, všechno černě
oDrgPrintMgr.ScaleMode = kPrintFullScale
oDrgPrintMgr.Orientation = kPortraitOrientation
oDrgPrintMgr.AllColorsAsBlack = True
oDrgPrintMgr.NumberOfCopies = 1
' Zjištění natočení listu a případná změna
Dim OtoceniListu As String

If oDrgDoc.ActiveSheet.Orientation = kPortraitPageOrientation Then
OtoceniListu = "na výšku"
Else
OtoceniListu = "na šířku"
End If

Dim MeritkoTisku As String
MeritkoTisku = "1 : 1"

Select Case oDrgDoc.ActiveSheet.Size
Case kA0DrawingSheetSize
VelikostListu = "A0"
Case kA1DrawingSheetSize
oDrgPrintMgr.Printer = "HP Designjet 500 24 by HP"
VelikostListu = "A1"
oDrgPrintMgr.PaperSize = kPaperSizeA1 'Nastavení papíru tiskárny
VelikostTisku = "A1"
oDrgPrintMgr.Orientation = kPortraitPageOrientation
oDrgPrintMgr.Rotate90Degrees = 1
OtoceniListu = "na výšku"
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
Case kA2DrawingSheetSize
oDrgPrintMgr.Printer = "HP Designjet 500 24 by HP"
VelikostListu = "A2"
oDrgPrintMgr.PaperSize = kPaperSizeA2 'Nastavení papíru tiskárny
VelikostTisku = "A2"
oDrgPrintMgr.Orientation = kLandscapeOrientation
If oDrgDoc.ActiveSheet.Orientation = kPortraitPageOrientation Then
oDrgPrintMgr.Rotate90Degrees = 1
Else
oDrgPrintMgr.Rotate90Degrees = 0
End If
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
Case kA3DrawingSheetSize
oDrgPrintMgr.Printer = "iR3025"
VelikostListu = "A3"
oDrgPrintMgr.PaperSize = kPaperSizeA3 'Nastavení papíru tiskárny
VelikostTisku = "A3"
oDrgPrintMgr.Orientation = kPortraitPageOrientation
oDrgPrintMgr.Rotate90Degrees = 1
Case kA4DrawingSheetSize
oDrgPrintMgr.Printer = "iR3025"
VelikostListu = "A4"
oDrgPrintMgr.PaperSize = kPaperSizeA4 'Nastavení papíru tiskárny
VelikostTisku = "A4"
oDrgPrintMgr.Orientation = kPortraitPageOrientation
oDrgPrintMgr.Rotate90Degrees = 0
Case Else
VelikostListu = "nestandartní"
End Select

If ListyKTisku = True Then
oDrgPrintMgr.PrintRange = kPrintAllSheets
Else
oDrgPrintMgr.PrintRange = kPrintCurrentSheet
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

'Ověření údajá a jestli opravdu tisknout
If ListyKTisku = True Then
If MsgBox("Tisknout aktuální výkres: " & JmenoDokumentu & Chr(13) & "( velikost: " & _
VelikostListu & ", " & OtoceniListu & ", " & PocetListu & " listú)" & Chr(13) & _
"na tiskárnu " & oDrgPrintMgr.Printer & Chr(13) & "na papír: " & VelikostTisku & ", " & MeritkoTisku & ", " & OtoceniListu & "?", vbYesNo + vbQuestion) = vbYes Then
oDrgPrintMgr.SubmitPrint
End If
Else
If MsgBox("Tisknout aktuální list číslo " & CisloAktivnihoListu & Chr(13) & _
"( " & JmenoAktualnihoListu & ", velikosti: " & VelikostListu & ", " & OtoceniListu & ", " & " ze " & PocetListu & " listú )" & Chr(13) & _
"na tiskárnu " & oDrgPrintMgr.Printer & Chr(13) & "na papír: " & VelikostTisku & ", " & MeritkoTisku & ", " & OtoceniListu & "?", vbYesNo + vbQuestion) = vbYes Then
oDrgPrintMgr.SubmitPrint
End If
End If

Else 'Když dokument není výkres
MsgBox "Lze tisknout jen výkresy"
End If
End Sub