Code:
Sub KombiA3()
PDF
DruckenA3
End Sub
Sub KombiA4()
PDF
DruckenA4
End Sub
Public Sub PDF()
'Print all sheets in drawing document
'Get the active document and check whether it's drawing document
If ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
Dim oDrgDoc As DrawingDocument
Set oDrgDoc = ThisApplication.ActiveDocument
' 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
' Set the printer name
' comment this line to use default printer or assign another one
oDrgPrintMgr.Printer = "PDFCreator"
oDrgPrintMgr.PrintRange = kPrintAllSheets
'Set the paper size and scale
On Error Resume Next
Select Case oDrgDoc.ActiveSheet.Size
Case kA4DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
oDrgPrintMgr.[Scale] = 1
oDrgPrintMgr.AllColorsAsBlack = True
Case kA3DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
oDrgPrintMgr.[Scale] = 1
oDrgPrintMgr.AllColorsAsBlack = True
Case kA2DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
oDrgPrintMgr.[Scale] = 1
oDrgPrintMgr.AllColorsAsBlack = True
Case kA1DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
oDrgPrintMgr.[Scale] = 1
oDrgPrintMgr.AllColorsAsBlack = True
'oDrgPrintMgr.Orientation = oDrgDoc.ActiveSheet.Orientation
Case kA0DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
oDrgPrintMgr.[Scale] = 1
oDrgPrintMgr.AllColorsAsBlack = True
Case Else ' Andere Werte.
Debug.Print "ungültiges Papierformat"
End Select
'Set the paper orientation
On Error Resume Next
Select Case oDrgDoc.ActiveSheet.Orientation
Case kLandscapePageOrientation
oDrgPrintMgr.Orientation = kLandscapeOrientation
Case kPortraitPageOrientation
oDrgPrintMgr.Orientation = kPortraitOrientation
AllColorsAsBlack = True
Case Else ' Andere Werte.
Debug.Print "ungültige Orientierung"
invDocument.Save
End Select
oDrgPrintMgr.SubmitPrint
End If
End Sub
Public Sub DruckenA3()
'Print all sheets in drawing document
'Get the active document and check whether it's drawing document
If ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
Dim oDrgDoc As DrawingDocument
Set oDrgDoc = ThisApplication.ActiveDocument
' 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
' Set the printer name
' comment this line to use default printer or assign another one
oDrgPrintMgr.Printer = "TOSHIBA e-STUDIO4520CSeriesPCL6"
oDrgPrintMgr.PrintRange = kPrintAllSheets
'Set the paper size and scale
On Error Resume Next
Select Case oDrgDoc.ActiveSheet.Size
Case kA4DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintCustomScale
oDrgPrintMgr.[Scale] = 1
Case kA3DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA3
oDrgPrintMgr.ScaleMode = kPrintCustomScale
oDrgPrintMgr.[Scale] = 1
Case kA2DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA3
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
Case kA1DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA3
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
Case kA0DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA3
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
Case Else ' Andere Werte.
Debug.Print "ungültiges Papierformat"
End Select
'Set the paper orientation
On Error Resume Next
Select Case oDrgDoc.ActiveSheet.Orientation
Case kLandscapePageOrientation
oDrgPrintMgr.Orientation = kLandscapeOrientation
Case kPortraitPageOrientation
oDrgPrintMgr.Orientation = kPortraitOrientation
Case Else ' Andere Werte.
Debug.Print "ungültige Orientierung"
End Select
oDrgPrintMgr.SubmitPrint
End If
End Sub
Public Sub DruckenA4()
'Print all sheets in drawing document
'Get the active document and check whether it's drawing document
If ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
Dim oDrgDoc As DrawingDocument
Set oDrgDoc = ThisApplication.ActiveDocument
' 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
' Set the printer name
' comment this line to use default printer or assign another one
oDrgPrintMgr.Printer = "TOSHIBA e-STUDIO4520CSeriesPCL6"
oDrgPrintMgr.PrintRange = kPrintAllSheets
'Set the paper size and scale
On Error Resume Next
Select Case oDrgDoc.ActiveSheet.Size
Case kA4DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintCustomScale
oDrgPrintMgr.[Scale] = 1
Case kA3DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
Case kA2DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
Case kA1DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
Case kA0DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
Case Else ' Andere Werte.
Debug.Print "ungültiges Papierformat"
End Select
'Set the paper orientation
On Error Resume Next
Select Case oDrgDoc.ActiveSheet.Orientation
Case kLandscapePageOrientation
oDrgPrintMgr.Orientation = kLandscapeOrientation
Case kPortraitPageOrientation
oDrgPrintMgr.Orientation = kPortraitOrientation
Case Else ' Andere Werte.
Debug.Print "ungültige Orientierung"
End Select
oDrgPrintMgr.SubmitPrint
End If
End Sub
Public Sub TEF_Stüli()
ChDir "C:\Users\Public\Documents\Autodesk\"
Call Shell("C:\Users\Public\Documents\Autodesk\1.cmd", 1)
End Sub
Private Sub PrintAll()
Dim oDoc As Document
For Each oDoc In ThisApplication.Documents
If oDoc.DocumentSubType = kDrawingDocument Then
' Set the printer name
' comment this line to use default printer or assign another one
oDrgPrintMgr.Printer = "TOSHIBA e-STUDIO4520CSeriesPCL6"
oDrgPrintMgr.PrintRange = kPrintAllSheets
'Set the paper size and scale
On Error Resume Next
Select Case oDrgDoc.ActiveSheet.Size
Case kA4DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintCustomScale
oDrgPrintMgr.[Scale] = 1
Case kA3DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
Case kA2DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
Case kA1DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
Case kA0DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
Case Else ' Andere Werte.
Debug.Print "ungültiges Papierformat"
End Select
'Set the paper orientation
On Error Resume Next
Select Case oDrgDoc.ActiveSheet.Orientation
Case kLandscapePageOrientation
oDrgPrintMgr.Orientation = kLandscapeOrientation
Case kPortraitPageOrientation
oDrgPrintMgr.Orientation = kPortraitOrientation
Case Else ' Andere Werte.
Debug.Print "ungültige Orientierung"
End Select
oDrgPrintMgr.SubmitPrint
End If
Next
End Sub
Sub test()
Dim oapp As Inventor.Application
Dim oDocument As Inventor.Document
Set oapp = ThisApplication
If oapp.ActiveDocument Is Nothing Then
MsgBox "Kein Dokument geöffnet"
Exit Sub
End If
For Each oDocument In oapp.Documents.VisibleDocuments
If oDocument.DocumentType = kDrawingDocumentObject Then
'Print all sheets in drawing document
'Get the active document and check whether it's drawing document
If ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
Dim oDrgDoc As DrawingDocument
Set oDrgDoc = ThisApplication.ActiveDocument
' 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
' Set the printer name
' comment this line to use default printer or assign another one
oDrgPrintMgr.Printer = "PDFCreator"
oDrgPrintMgr.PrintRange = kPrintAllSheets
'Set the paper size and scale
On Error Resume Next
Select Case oDrgDoc.ActiveSheet.Size
Case kA4DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
oDrgPrintMgr.[Scale] = 1
oDrgPrintMgr.AllColorsAsBlack = True
Case kA3DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
oDrgPrintMgr.[Scale] = 1
oDrgPrintMgr.AllColorsAsBlack = True
Case kA2DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
oDrgPrintMgr.[Scale] = 1
oDrgPrintMgr.AllColorsAsBlack = True
Case kA1DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
oDrgPrintMgr.[Scale] = 1
oDrgPrintMgr.AllColorsAsBlack = True
'oDrgPrintMgr.Orientation = oDrgDoc.ActiveSheet.Orientation
Case kA0DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
oDrgPrintMgr.[Scale] = 1
oDrgPrintMgr.AllColorsAsBlack = True
Case Else ' Andere Werte.
Debug.Print "ungültiges Papierformat"
End Select
'Set the paper orientation
On Error Resume Next
Select Case oDrgDoc.ActiveSheet.Orientation
Case kLandscapePageOrientation
oDrgPrintMgr.Orientation = kLandscapeOrientation
Case kPortraitPageOrientation
oDrgPrintMgr.Orientation = kPortraitOrientation
AllColorsAsBlack = True
Case Else ' Andere Werte.
Debug.Print "ungültige Orientierung"
invDocument.Save
End Select
oDrgPrintMgr.SubmitPrint
End If
Next
End Sub
Public Sub DruckenA3Multi()
'Print all sheets in drawing document
'Get the active document and check whether it's drawing document
Dim oapp As Inventor.Application
Dim oDocument As Inventor.Document
Set oapp = ThisApplication
If oapp.ActiveDocument Is Nothing Then
MsgBox "Kein Dokument geöffnet"
Exit Sub
End If
For Each oDocument In oapp.Documents.VisibleDocuments
If oDocument.DocumentType = kDrawingDocumentObject Then
oDocument.Activate
Dim oDrgDoc As DrawingDocument
Set oDrgDoc = ThisApplication.ActiveDocument
' 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
' Set the printer name
' comment this line to use default printer or assign another one
oDrgPrintMgr.Printer = "TOSHIBA e-STUDIO4520CSeriesPCL6"
oDrgPrintMgr.PrintRange = kPrintAllSheets
'Set the paper size and scale
On Error Resume Next
Select Case oDrgDoc.ActiveSheet.Size
Case kA4DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
oDrgPrintMgr.[Scale] = 1
oDrgPrintMgr.AllColorsAsBlack = True
Case kA3DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA3
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
oDrgPrintMgr.[Scale] = 1
oDrgPrintMgr.AllColorsAsBlack = True
Case kA2DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA3
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
oDrgPrintMgr.AllColorsAsBlack = True
Case kA1DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA3
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
oDrgPrintMgr.AllColorsAsBlack = True
Case kA0DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA3
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
oDrgPrintMgr.AllColorsAsBlack = True
Case Else ' Andere Werte.
Debug.Print "ungültiges Papierformat"
End Select
'Set the paper orientation
On Error Resume Next
Select Case oDrgDoc.ActiveSheet.Orientation
Case kLandscapePageOrientation
oDrgPrintMgr.Orientation = kLandscapeOrientation
Case kPortraitPageOrientation
oDrgPrintMgr.Orientation = kPortraitOrientation
Case Else ' Andere Werte.
Debug.Print "ungültige Orientierung"
End Select
oDrgPrintMgr.NumberOfCopies = UserForm1.TextBox1.Text
oDrgPrintMgr.SubmitPrint
End If
Next
End Sub
Sub Multi()
UserForm1.Show '"UserForm1"
End Sub
Public Sub PDFMULTI()
'Print all sheets in drawing document
'Get the active document and check whether it's drawing document
Dim oapp As Inventor.Application
Dim oDocument As Inventor.Document
Set oapp = ThisApplication
If oapp.ActiveDocument Is Nothing Then
MsgBox "Kein Dokument geöffnet"
Exit Sub
End If
For Each oDocument In oapp.Documents.VisibleDocuments
If oDocument.DocumentType = kDrawingDocumentObject Then
oDocument.Activate
Dim oDrgDoc As DrawingDocument
Set oDrgDoc = ThisApplication.ActiveDocument
' 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
' Set the printer name
' comment this line to use default printer or assign another one
oDrgPrintMgr.Printer = "PDFCreator"
oDrgPrintMgr.PrintRange = kPrintAllSheets
'Set the paper size and scale
On Error Resume Next
Select Case oDrgDoc.ActiveSheet.Size
Case kA4DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
oDrgPrintMgr.[Scale] = 1
oDrgPrintMgr.AllColorsAsBlack = True
Case kA3DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
oDrgPrintMgr.[Scale] = 1
oDrgPrintMgr.AllColorsAsBlack = True
Case kA2DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
oDrgPrintMgr.[Scale] = 1
oDrgPrintMgr.AllColorsAsBlack = True
Case kA1DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
oDrgPrintMgr.[Scale] = 1
oDrgPrintMgr.AllColorsAsBlack = True
'oDrgPrintMgr.Orientation = oDrgDoc.ActiveSheet.Orientation
Case kA0DrawingSheetSize
oDrgPrintMgr.PaperSize = kPaperSizeA4
oDrgPrintMgr.ScaleMode = kPrintBestFitScale
oDrgPrintMgr.[Scale] = 1
oDrgPrintMgr.AllColorsAsBlack = True
Case Else ' Andere Werte.
Debug.Print "ungültiges Papierformat"
End Select
'Set the paper orientation
On Error Resume Next
Select Case oDrgDoc.ActiveSheet.Orientation
Case kLandscapePageOrientation
oDrgPrintMgr.Orientation = kLandscapeOrientation
Case kPortraitPageOrientation
oDrgPrintMgr.Orientation = kPortraitOrientation
AllColorsAsBlack = True
Case Else ' Andere Werte.
Debug.Print "ungültige Orientierung"
invDocument.Save
End Select
oDrgPrintMgr.SubmitPrint
End If
Next
End Sub
Public Sub Streamline()
ChDir "C:\Program Files (x86)\ProjectPoint-2011"
Call Shell("C:\Program Files (x86)\ProjectPoint-2011\ProjectPoint.exe", 1)
End Sub