Sub ExportRozpiskaToCSV()
Dim invApp As Inventor.Application
Dim drawingDoc As Inventor.DrawingDocument
Dim partsList As partsList
Dim tableRow As PartsListRow
Dim csvFile As String
Dim outputFile As Integer
Dim rowIndex As Integer
Dim colIndex As Integer
Dim cellValue As String
' Připojení k aplikaci Inventor
On Error Resume Next
Set invApp = GetObject(, "Inventor.Application")
If invApp Is Nothing Then
MsgBox "Inventor není spuštěn."
Exit Sub
End If
On Error GoTo 0
' Získání aktivního výkresového dokumentu
Set drawingDoc = invApp.ActiveDocument
' Kontrola, zda je aktivní dokument výkres
If drawingDoc.DocumentType <> kDrawingDocumentObject Then
MsgBox "Aktivní dokument není výkres!"
Exit Sub
End If
' Získání rozpisky (PartsList) na výkresu
If drawingDoc.PartsLists.Count = 0 Then
MsgBox "Na výkresu není žádná rozpiska!"
Exit Sub
End If
' Předpokládáme, že chceme exportovat první rozpisku (pokud jich je více, můžete si vybrat konkrétní)
Set partsList = drawingDoc.PartsLists(1)
' Cesta k exportnímu souboru CSV
csvFile = "C:\temp\rozpiska_export.csv"
outputFile = FreeFile
' Otevření souboru pro zápis
Open csvFile For Output As outputFile
' Iterace přes řádky a sloupce rozpisky a zápis do CSV
For rowIndex = 1 To partsList.PartsListRows.Count
' Inicializace řádku pro CSV
Dim rowData As String
rowData = ""
Set tableRow = partsList.PartsListRows(rowIndex)
' Iterace přes jednotlivé buňky v řádku
For colIndex = 1 To partsList.ColumnCount
cellValue = tableRow.Item(colIndex).Value
' Přidání hodnoty buňky do řádku a oddělení středníkem
rowData = rowData & cellValue & ";"
Next colIndex
' Odstranění posledního středníku a zapsání řádku do CSV
rowData = Left(rowData, Len(rowData) - 1)
Print #outputFile, rowData
Next rowIndex
' Uzavření souboru
Close outputFile
MsgBox "Rozpiska byla úspěšně exportována do: " & csvFile
End Sub