Catia Macro Nomenclature to Excel

Hello

First of all, at least make an effort to proofread the post, without a code re-indentation plugin on a third-party text editor, it quickly becomes a problem!

It's ILLEGIBLE on this page.

I focused only on the CATMain() function and there are already things to review. The macro is so dense that I’ll leave it to the other motivated helpers to tackle it ^^'

Here is my proofreading of the function.

-- macro catia -- Sub CATMain() ' Check if the active document is a CATProduct On Error Resume Next Set myDocument = CATIA.ActiveDocument If Err.Number <> 0 Then MsgBox "There is no file open in CATIA", vbCritical, "Error" End End If If TypeName(myDocument) <> "ProductDocument" Then MsgBox "The active document must be a CATProduct", vbCritical, "Error" End End If Set myProduct = myDocument.Product ' export bill of material Dim productDocument1 As ProductDocument Set productDocument1 = CATIA.ActiveDocument Dim product1 As Product Set product1 = productDocument1.Product Dim assemblyConvertor1 As AssemblyConvertor Set assemblyConvertor1 = product1.GetItem("BillOfMaterial") '##################################################################################### ' Dim arrayOfVariantOfBSTR5(11) reserves an array of 12 elements, it correctly counts 0 ' Using 0 To 10 for clearer code '##################################################################################### Dim arrayOfVariantOfBSTR5(0 To 10) arrayOfVariantOfBSTR5(0) = "Quantity" arrayOfVariantOfBSTR5(1) = "Type" arrayOfVariantOfBSTR5(2) = "Reference" arrayOfVariantOfBSTR5(3) = "Revision" arrayOfVariantOfBSTR5(4) = "Definition" arrayOfVariantOfBSTR5(5) = "Nomenclature" arrayOfVariantOfBSTR5(6) = "Source" arrayOfVariantOfBSTR5(7) = "MASS" arrayOfVariantOfBSTR5(8) = "MATERIAL" arrayOfVariantOfBSTR5(9) = "ITEM" arrayOfVariantOfBSTR5(10) = "SUPPLIER" '##################################################################################### ' Define the size of assemblyConvertor1Variant '##################################################################################### Dim assemblyConvertor1Variant As Variant Set assemblyConvertor1Variant = assemblyConvertor1 assemblyConvertor1Variant.SetCurrentFormat arrayOfVariantOfBSTR5 '##################################################################################### ' Dim arrayOfVariantOfBSTR5(11) reserves an array of 12 elements, it correctly counts 0 ' Using 0 To 10 for clearer code '##################################################################################### Dim arrayOfVariantOfBSTR6(0 To 10) arrayOfVariantOfBSTR6(0) = "Quantity" arrayOfVariantOfBSTR6(1) = "Type" arrayOfVariantOfBSTR6(2) = "Reference" arrayOfVariantOfBSTR6(3) = "Revision" arrayOfVariantOfBSTR6(4) = "Definition" arrayOfVariantOfBSTR6(5) = "Nomenclature" arrayOfVariantOfBSTR6(6) = "Source" arrayOfVariantOfBSTR6(7) = "MASS" arrayOfVariantOfBSTR6(8) = "MATERIAL" arrayOfVariantOfBSTR6(9) = "ITEM" arrayOfVariantOfBSTR6(10) = "SUPPLIER" '##################################################################################### ' SetSecondaryFormat redefines assemblyConvertor1Variant '##################################################################################### assemblyConvertor1Variant.SetSecondaryFormat arrayOfVariantOfBSTR6 '##################################################################################### ' Print is a function '##################################################################################### assemblyConvertor1.Print "XLS", "C:\Temp\export.xls", product1 '##################################################################################### ' Set wb = ExcelApp.Workbook.Open(path) ' wb is never used '##################################################################################### Dim ExcelApp As Object Dim Workbook As Object '##################################################################################### ' Dim FilePath is never used, see line 100 ' Beware of case sensitivity, there are FilePath and filepath for 2 similar variables! '##################################################################################### Dim filepath2 As String ' Specify the full path to your Excel file FilePath = "C:\Temp\export.xls" filepath2 = "C:\Temp\modifexcel.xlsm" ' Create an instance of Excel Set ExcelApp = CreateObject("Excel.Application") ' Make Excel visible (optional) ExcelApp.Visible = True ' Open the Excel file '##################################################################################### ' Set Workbook = ExcelApp.Workbooks.Open(FilePath) ' This line is unnecessary, Workbook is immediately redefined '##################################################################################### Set Workbook = ExcelApp.Workbooks.Open(filepath2) ' Run a macro from the opened workbook '##################################################################################### ' objExcel is not defined anywhere here '##################################################################################### ExcelApp.Run "bommodif" End Sub

For the motivated, here is an indented version of the macro.

-- excel macro-- Sub bommodif() ' bommodif Macro Dim condition1 As String Dim condition2 As String Dim condition3 As String Dim condition4 As String Dim condition5 As String Dim searchword As String Dim searchword2 As String Dim result As String Dim found As Boolean Dim start As Range Dim cell As Range Dim foundcell As Range Dim foundcell2 As Range Dim i As Long Dim j As Long Dim k As Long Dim a As Long Dim b As Long Dim line As Long Dim lastrowsource As Long Dim lastrowdestination As Long Dim lastrowdestination2 As Long Dim wbsource As Worksheet Dim wbdestination As Worksheet Dim dict As Object Dim dict2 As Object Dim sourceworkbook As Workbook Dim sourcesheet As Worksheet Dim destinationworkbook As Workbook Dim destinationsheet As Worksheet Dim destinationsheet2 As Worksheet ' copy data from export.xls to this file Set sourceworkbook = Workbooks.Open("C:\temp\export.xls") Set sourcesheet = sourceworkbook.Sheet1 Set destinationworkbook = Workbooks.Open("C:\temp\modifexcel.xlsm") Set destinationsheet = destinationworkbook.Sheet1 sourcesheet.UsedRange.Copy destinationsheet.Range("A1") sourceworkbook.Close ' create a new sheet in "modifexcel" workbook destinationworkbook.Select sheetname = "Sheet2" On Error Resume Next Set destinationworkbook = Workbooks.Open("C:\temp\modifexcel.xlsm") Set destinationsheet2 = destinationworkbook.Sheets(sheetname) On Error GoTo 0 If destinationsheet2 Is Nothing Then Set destinationsheet2 = destinationworkbook.Sheets.Add(After:=destinationworkbook.Sheets(destinationworkbook.Sheets.Count)) destinationsheet2.Name = sheetname End If ' clear data and any formatting in sheet 2 Sheets("Sheet2").Select Cells.Select Selection.ClearContents With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With ' copy and paste column headers Sheets("Sheet1").Select Range("A4:K4").Select Selection.Copy Sheets("Sheet2").Select Range("A2").Select ActiveSheet.Paste ' format the table (width, centered text) Range("A:A,B:B,D:D,G:G,H:H").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Range("C2,E2,F2,I2,J2,K2").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Range("A:A,D:D,G:G,H:H").Select Selection.ColumnWidth = 8 Range("F:F,I:I,J:J,K:K").Select Selection.ColumnWidth = 30 Columns("B:B").Select Selection.ColumnWidth = 12 Columns("C:C").Select Selection.ColumnWidth = 40 Columns("E:E").Select Selection.ColumnWidth = 45 Range("A2:K2").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent3 .TintAndShade = 0.799981688894314 .PatternTintAndShade = 0 End With ' add title row for assemblies Range("A3").Select ActiveCell.FormulaR1C1 = "ASSEMBLY" Range("A3:K3").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.NumberFormat = "@" Range("A3:K3").Select With Selection .HorizontalAlignment = xlCenterAcrossSelection .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With ' copy and paste assembly data with condition "assembly" condition1 = "Assembly" Set wbsource = Sheets("Sheet1") lastrowsource = wbsource.Cells(Rows.Count, 1).End(xlUp).Row Set wbdestination = Sheets("Sheet2") lastrowdestination = 4 For i = 1 To lastrowsource If wbsource.Cells(i, 2).Value = condition1 Then wbsource.Rows(i).Copy wbdestination.Rows(lastrowdestination) lastrowdestination = lastrowdestination + 1 End If Next i ' add title row for "manufactured parts" taking into account random number of rows added for assemblies a = wbdestination.Cells(Rows.Count, 1).End(xlUp).Row Cells(a + 1, 1).Select ActiveCell.FormulaR1C1 = "MANUFACTURED PART" Range(Cells(a + 1, 1), Cells(a + 1, 11)).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.NumberFormat = "@" Range(Cells(a + 1, 1), Cells(a + 1, 11)).Select With Selection .HorizontalAlignment = xlCenterAcrossSelection .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With ' copy and paste "manufactured parts" data with search from a keyword and conditions "parts" "manufactured" searchword = "Summary" condition2 = "Part" condition3 = "Manufactured" lastrowdestination = lastrowdestination + 1 Set dict = CreateObject("scripting.dictionary") Set foundcell = wbsource.Columns(1).Find(searchword, LookIn:=xlValues, LookAt:=xlWhole) If Not foundcell Is Nothing Then For j = foundcell.Row To lastrowsource If wbsource.Cells(j, 2).Value Like condition2 And wbsource.Cells(j, 7).Value Like condition3 Then Dim key As String key = wbsource.Cells(j, 3).Value & "|" If Not dict.exists(key) Then dict.Add key, Nothing wbsource.Rows(j).Copy wbdestination.Rows(lastrowdestination) lastrowdestination = lastrowdestination + 1 End If End If Next j End If ' add title row for "purchased parts" taking into account random number of rows added for manufactured parts b = wbdestination.Cells(Rows.Count, 1).End(xlUp).Row Cells(b + 1, 1).Select ActiveCell.FormulaR1C1 = "PURCHASED PART" Range(Cells(b + 1, 1), Cells(b + 1, 11)).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.NumberFormat = "@" Range(Cells(b + 1, 1), Cells(b + 1, 11)).Select With Selection .HorizontalAlignment = xlCenterAcrossSelection .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With ' copy and paste "purchased parts" data with search from a keyword and conditions "parts" "purchased" searchword = "Summary" condition2 = "Part" condition4 = "Purchased" lastrowdestination = lastrowdestination + 1 Set dict = CreateObject("scripting.dictionary") Set foundcell = wbsource.Columns(1).Find(searchword, LookIn:=xlValues, LookAt:=xlWhole) If Not foundcell Is Nothing Then For j = foundcell.Row To lastrowsource If wbsource.Cells(j, 2).Value Like condition2 And wbsource.Cells(j, 7).Value Like condition4 Then Dim key2 As String key2 = wbsource.Cells(j, 3).Value & "|" If Not dict.exists(key2) Then dict.Add key2, Nothing wbsource.Rows(j).Copy wbdestination.Rows(lastrowdestination) lastrowdestination = lastrowdestination + 1 End If End If Next j End If End Sub

The MAANGs don’t have oil but they have data!
Do you feel my Big Data?
Sacrifice some freedoms for more security and you lose them ALL.
ALL YOUR DATABASE ARE BELONG TO US

hello,

can you share your file and specify the differences between what you are getting and what you are expecting?

Hello
Thank you to luckydu43 for your response, sorry if my post is unbearable, it's only the second time I've used this site and I simply copied and pasted my macros

yg_be how do I share my file with you?

Hello,

Can you upload it to "Cjoint" and paste the link you will have requested in your reply?

  https://www.cjoint.com/

https://www.cjoint.com/c/NJEmSMmakXX

In fact, I started from Catia V5 of a product, I generated a bill of materials that I saved as export.xls, from there I created a macro that allows me to compile the data into an organized table.

But when I run the macro in Catia, nothing happens in my Excel file.

What I would like to obtain can be found on sheet 2 of the Excel file "ess11.xlsm."

Hello

When I run the macro from Catia, it correctly opens both requested Excel files "export.xls" and "modifexcel.xlsm". In the "export.xls" file, I have the desired data, namely "the bill of materials" from the open Catia product.

It’s after that it doesn’t work anymore.

What I would like to achieve is:

to run the macro "essai.catvba" from CATIA V5

then based on the exported data found in "export.xls", create an ordered table (see desired layout in the Excel file "ess11.xlsm" sheet2) whether the created table is in the "export.xls" or "modifexcel.xlsm" file doesn't matter to me, and then have it saved.

If possible, by only running the macro from Catia.

In the "ess11.xlsm" file, there is a macro "zz" that does the requested job except for one thing: I can't get the complete list of purchased parts.

To summarize, from the macro "essai.catvba" launched from Catia, I want to obtain the sheet2 table from the file "ess11.xlsm"; it's somewhat a mix between the two macros.

The first thing to do is to add "option explicit" at the beginning of each module.

This will help you catch errors in variable names.