Message 1 of 5
Inventor I logic bombs at second sheet of BOM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I have an ilogic written before my time that has stopped working. It seems to end if there are sheets that don't have a PL on them. I need to retain all attributes for the first couple sheets. Then renumber the sheets so it displays the sheet that the pl came from correctly. Please don't change the first two sheets they work as intended. Here is the code. It used to work fine before install of 2021 Inventor and maybe new excel version or update. I need it to cont. if a sheet has no bom, and renumber sheet name on tabs. Ignore the first two sheets, that just puts it in our BOM system and adds routings. Just need to fix the thing so it gets all of the sheets again from the idw that have a BOM and renumbers accordingly. Any help greatly appreciated.
Dim oDoc As Document = ThisDoc.Document Dim oDrawDoc As DrawingDocument = ThisDrawing.Document Dim oSheets As Inventor.Sheets = oDrawDoc.Sheets Dim oSheet As Sheet Dim oRevTable As RevisionTable = oSheets(1).RevisionTables.Item(1) RevLevel = oRevTable.RevisionTableRows.Count 'get the path and name of the drawing file path_and_name = ThisDoc.PathAndFileName(False) ' without extension FullName = path_and_name & ".xls" 'check for existing XLS file and delete it if found ExistingFile = Dir(path_and_name & ".xls*") If ExistingFile <> "" Then i = MessageBox.Show("The file already exists: " & vbCr & vbCr & path_and_name & ".xls" & vbCr & vbCr & "Do you want to overwrite the file?", "File Exists", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1) If i = vbYes Then Kill (FullName) Else Exit Sub End If Else End If iCount = 1 For SheetNum = oSheets.Count To 1 Step -1 ThisApplication.StatusBarText = "Exporting Sheet " & iCount & " of " & oSheets.Count & " Please Wait!" Try oPartslist = oSheets(SheetNum).PartsLists(1) ' create a new NameValueMap object oOptions = ThisApplication.TransientObjects.CreateNameValueMap 'specify an existing template file 'to use For formatting colors, fonts, etc 'oOptions.Value("Template") = ThisDoc.Path & "\BOM Template.xlsx" 'specify the columns to export 'oOptions.Value("ExportedColumns") = "QTY;PART NUMBER;DESCRIPTION" 'specify the start cell oOptions.Value("StartingCell") = "A2" 'specify the XLS tab name 'here the file name is used oOptions.Value("TableName") = "BOM-Sheet " & SheetNum 'without extension 'choose to include the parts list title row 'in this example "Ye Old List of Parts" is written to the StartingCell oOptions.Value("IncludeTitle") = False 'choose to autofit the column width in the xls file oOptions.Value("AutoFitColumnWidth") = True ' export the Partslist to Excel with options oPartslist.Export(FullName, PartsListFileFormatEnum.kMicrosoftExcel, oOptions) Catch End Try iCount = iCount + 1 LastSheet = SheetNum Next ThisApplication.StatusBarText = "Finalizing BOM Export Please Wait!" xlLeft = -4131 xlCenter = -4108 xlRight = -4152 xlContinuous = 1 xlEdgeLeft = 7 xlEdgeTop = 8 xlEdgeBottom = 9 xlEdgeRight = 10 xlInsideVertical = 11 xlInsideHorizontal = 12 ExcelApp = CreateObject("Excel.Application") ExcelApp.Visible = False ExcelApp.DisplayAlerts = False ExcelWorkbook = ExcelApp.Workbooks.Open(FullName) '''Format Export Dim SheetCount As Integer Dim Fail as Boolean Dim DropCount As Integer SheetCount = 1 For Each sh In ExcelWorkbook.Worksheets sh.Range("A:G").HorizontalAlignment = xlLeft With sh.Range("A1:G1") .Value = "COMPONENT COMBINED BILL OF MATERIALS" .MergeCells = True .Font.Size = 18 .Font.Bold = True .HorizontalAlignment = xlCenter End With With sh.Range("A2:G2") .Font.Bold = True .Borders(xlEdgeLeft).LineStyle = xlContinuous .Borders(xlEdgeTop).LineStyle = xlContinuous .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeRight).LineStyle = xlContinuous .Borders(xlInsideVertical).LineStyle = xlContinuous End With sh.Columns("A").ColumnWidth = 8.5 sh.Columns("B").ColumnWidth = 8.5 sh.Columns("C").ColumnWidth = 122.5 sh.Columns("D").ColumnWidth = 39 sh.Columns("E").ColumnWidth = 35 sh.Columns("F").ColumnWidth = 8 sh.Columns("G").ColumnWidth = 24.5 With sh.PageSetup .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = False .Orientation = 2 End With Next '''Routings RoutingSheet = ExcelWorkbook.sheets.Add RoutingSheet.Name = "Routings" RoutingSheet.Columns("A").ColumnWidth = 17 RoutingSheet.Columns("B").ColumnWidth = 11 With RoutingSheet.Range("A1:B1") .MergeCells = True .Value = "Shop Routings" .Font.Size = 18 .Font.Bold = True .HorizontalAlignment = xlCenter End With RoutingSheet.Range("B:B").HorizontalAlignment = xlCenter With RoutingSheet.Range("A1:B16") .Borders(xlEdgeLeft).LineStyle = xlContinuous .Borders(xlEdgeTop).LineStyle = xlContinuous .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeRight).LineStyle = xlContinuous .Borders(xlInsideVertical).LineStyle = xlContinuous .Borders(xlInsideHorizontal).LineStyle = xlContinuous End With With RoutingSheet.PageSetup .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = False .Orientation = 1 End With RoutingSheet.Range("A2:B2").Font.Bold = True RoutingSheet.Range("A2").Value = "WORK CENTER" RoutingSheet.Range("B2").Value = "HOURS" RoutingSheet.Range("A3").Value = "PROGRAMING" RoutingSheet.Range("A4").Value = "BURN/CLEAN" RoutingSheet.Range("A5").Value = "LAY/FAB" RoutingSheet.Range("A6").Value = "MACHINING" RoutingSheet.Range("A7").Value = "WELDING" RoutingSheet.Range("A8").Value = "ASYTST-M" RoutingSheet.Range("A9").Value = "CLEAN/PAIN" RoutingSheet.Range("A10").Value = "ASYTST-E" RoutingSheet.Range("A11").Value = "STOCKTST" '''Properties PropertiesSheet = ExcelWorkbook.Sheets.add PropertiesSheet.Name = "Component Properties" PropertiesSheet.Columns("A").ColumnWidth = 14.25 PropertiesSheet.Columns("B").ColumnWidth = 94 With PropertiesSheet.Range("A1:B1") .MergeCells = True .Value = "Job Specific Data Table & Component Properties" .Font.Size = 18 .Font.Bold = True .HorizontalAlignment = xlCenter End With PropertiesSheet.Range("A2:A9").Font.Bold = True PropertiesSheet.Range("A2").Value = "Job#" PropertiesSheet.Range("B2").Value = iProperties.Value("Custom", "JOB NO") PropertiesSheet.Range("A3").Value = "Mark#" PropertiesSheet.Range("B3").Value = iProperties.Value("Custom", "MARK NO") PropertiesSheet.Range("A4").Value = "Desc." PropertiesSheet.Range("B4").Value = iProperties.Value("Custom", "SHORT DESC") PropertiesSheet.Range("A5").Value = "Ext Desc." PropertiesSheet.Range("B5").Value = iProperties.Value(iProperties.Value("Project", "Part Number")&".iam", "Project", "Description") PropertiesSheet.Range("A6").Value = "P/N" PropertiesSheet.Range("B6").Value = iProperties.Value("Project", "Part Number") PropertiesSheet.Range("A7").Value = "Drawing" PropertiesSheet.Range("B7").Value = iProperties.Value("Project", "Part Number") PropertiesSheet.Range("A8").Value = "Revision" PropertiesSheet.Range("B8").Value = RevLevel PropertiesSheet.Range("A9").Value = "Make Qty" PropertiesSheet.Range("B9").Value = iProperties.Value("Custom", "MAKE QTY") PropertiesSheet.Range("A33").Value = "UserID" PropertiesSheet.Range("B33").Value = System.Environment.UserName PropertiesSheet.Range("A34").Value = "MachineID" PropertiesSheet.Range("B34").Value = System.Environment.MachineName PropertiesSheet.Range("B:B").HorizontalAlignment = xlLeft With PropertiesSheet.Range("A1:B9") .Borders(xlEdgeLeft).LineStyle = xlContinuous .Borders(xlEdgeTop).LineStyle = xlContinuous .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeRight).LineStyle = xlContinuous .Borders(xlInsideVertical).LineStyle = xlContinuous .Borders(xlInsideHorizontal).LineStyle = xlContinuous End With With PropertiesSheet.PageSetup .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = False .Orientation = 2 End With ExcelWorkbook.Save i = MessageBox.Show("Export completed successfully!" & vbCr & vbCr & "Would you like to view the output now?", "Export Complete", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1) If i = vbNo Then ExcelWorkbook.Close ExcelApp.Quit Else ExcelApp.Visible = True End If ExcelWorkbook = Nothing ExcelApp = Nothing
