BOM extraction macro in detailed tabulation without welded parts

Hello

I have a macro that works great to generate an Excel of my BOMs, but I can't exclude welded parts that I never process in a general BOM of the whole machine.
My nomenclature is correct in the plan, but not in the export.

Capture

I understand that the last term should be " False " but...

BomType = swBomType_Indented
Configuration = " Default" ‹ name of the set  configuration ›
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(TemplateName, 0, 0, BomType, Configuration, False, swNumberingType_Detailed, False)
Set swBOMFeature = swBOMAnnotation.BomFeature

swModel.ForceRebuild3 True

What to do?

The code given seems good to me. Indeed, it is the last False to check or uncheck the detailed list.
Can you attach the rest of the code to see if the error is not coming from the rest?
And also it's easier to read the code when it's inserted with the right tags.
To do this, click here:
image

Puis tu remplaces le texte ici par ton code
2 Likes


Sub main()

Dim xlApp As Object
Dim wbk As Object 'not Workbook
Dim sht As Object 'not Worksheet
'si nécessaire : Dim rng As Object 'not Range'

Dim swApp                   As SldWorks.SldWorks
Dim swModel                 As SldWorks.ModelDoc2
Dim swModelDocExt           As SldWorks.ModelDocExtension
Dim swBOMAnnotation         As SldWorks.BomTableAnnotation
Dim swBOMFeature            As SldWorks.BomFeature
Dim boolstatus              As Boolean
Dim BomType                 As Long
Dim Configuration           As String
Dim TemplateName            As String

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
    swApp.SendMsgToUser2 ("Aucun assemblage actif détecté."), swMbWarning, swMbOk 'test l'activité du document
    Exit Sub
ElseIf swModel.GetType <> swDocASSEMBLY Then
    swApp.SendMsgToUser2 ("Aucun assemblage actif détecté."), swMbWarning, swMbOk 'test que le fichier est un assemblage
    Exit Sub
ElseIf swModel.GetPathName = "" Then
    swApp.SendMsgToUser2 ("Assemblage non enregistré."), swMbWarning, swMbOk 'test que l'assemblage est enregistré
    Exit Sub
End If
Set swModelDocExt = swModel.Extension

Set xlApp = CreateObject("Excel.Application")
Set wbk = xlApp.Workbooks.Open("(.......)Nomenclature.xls") ' ouverture du modèle 'ou création d'un nouveau: Set wbk = xlApp.Workbooks.Add
'si nécessaire : Sélection feuille existante: Set sht = wbk.Worksheets(1)': ajout d'une feuille de calculSet wks = wbk.Sheets.Add'
'si nécessaire : Sélection d'une cellule : Set rng = thisWs.Range("A11")'

TemplateName = "(...)\Nomenclatures\Détaillée.sldbomtbt" 'création de la nomenclature automatique solidworks suivant modèle'
BomType = swBomType_Indented
Configuration = "Défaut" 'nom de la configuration de l'ensemble'
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(TemplateName, 0, 0, BomType, Configuration, False, swNumberingType_Detailed, False)
Set swBOMFeature = swBOMAnnotation.BomFeature

swModel.ForceRebuild3 True

Dim NumCol As Long
Dim NumRow As Long
Dim I As Long
Dim J As Long

NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount

For I = 0 To NumRow
    For J = 0 To NumCol
      wbk.Sheets("Nomenclature").Cells(I + 9, J + 1) = swBOMAnnotation.Text(I + 1, J) 'écriture des données de nomenclature'
    Next J
Next I

boolstatus = swModelDocExt.SelectByID2(swBOMFeature.GetFeature.Description, "BOMFEATURE", 0, 0, 0, True, 0, Nothing, 0)
swModel.EditDelete

swModel.ForceRebuild3 True

Dim config As SldWorks.Configuration
Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim lRetVal As Long
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Dim nNbrProps As Long
Dim vPropNames As Variant
Dim vPropTypes As Variant
Dim vPropValues As Variant
Dim resolved As Variant
Dim custPropType As Long
Dim K As Long
Dim NomProperty1 As String
Dim NomProperty2 As String
Dim NomProperty3 As String
Dim NomProperty4 As String
Dim NomProperty5 As String
Dim NomProperty6 As String
Dim NomProperty7 As String
Dim DateStr As Date

Set config = swModel.GetActiveConfiguration ': pointe vers les propriétés solidworks du document actif
'Set cusPropMgr = config.CustomPropertyManager' : récupération des propriétés spécifiques à la configuration (Solidworks > propriétés> spécifiques à la config.
Set cusPropMgr = swModelDocExt.CustomPropertyManager("") 'récupération des propriétés personnalisées

nNbrProps = cusPropMgr.Count
vPropNames = cusPropMgr.GetNames
For K = 0 To nNbrProps - 1
    cusPropMgr.Get2 vPropNames(K), ValOut, ResolvedValOut
    custPropType = cusPropMgr.GetType2(vPropNames(K))
        If vPropNames(K) = "N° de projet" Then 'récupération de la propriété "N° de projet"'
        NomProperty1 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(1, 3) = NomProperty1
    End If
    If vPropNames(K) = "N° Plan / Réf / Dim" Then
        NomProperty2 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(1, 5) = "-" & NomProperty2
    End If
    If vPropNames(K) = "Nom de projet" Then
        NomProperty3 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(3, 3) = NomProperty3
    End If
    If vPropNames(K) = "Désignation" Then
        NomProperty4 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(5, 3) = NomProperty4
    End If
    If vPropNames(K) = "Dessinateur" Then
        NomProperty5 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(2, 7) = "   Dessinateur :   " & NomProperty5
    End If
    If vPropNames(K) = "Vérificateur" Then
        NomProperty6 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(3, 7) = "   Vérificateur :   " & NomProperty6
    End If
    If vPropNames(K) = "Indice en cours" Then
        NomProperty7 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(4, 7) = "   Indice en cours :   " & NomProperty7
    End If
Next K

wbk.Sheets("Nomenclature").Cells(1, 6) = "   Date:   " & DateValue(Now) 'extraction date du système

Dim chemin As String
chemin = Strings.Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) & "-" & NomProperty7 & " -Détaillée " & ".xls"  'renseignement du chemin et du nom d'enregistrement '& NomProperty : ajout d'une propriété personnalisée au nom de fichier

With xlApp
    .DisplayAlerts = False
    .EnableEvents = False
    wbk.SaveAs chemin  'enregistre le fichier et écrase si fichier déjà existant
    .DisplayAlerts = True
    .EnableEvents = True
    wbk.Close  'ferme le workbook
    .Quit  'quitte excel
End With

swApp.SendMsgToUser2 ("Nomenclature de l'ensemble de la machine créée."), swMbInformation, swMbOk 'msgbox solidworks

End Sub


Hello @tous
On my side the nomenclature and the export are correct,
@Aritech, you said that your nomenclature is correct, yet the export part only copies the cells! , the nomenclature doesn't have this type of grouping of bodies by chance?

Hello, thank you for your feedback.

I have this type of grouping.


it works in SW, but not in export. It goes even further. For export, I even have the unfolded folded sheet metal which adds a life line, which is useless for me.
If I understand what I read in the shared thread it's that it's a bug fixed in the SW2022

1 Like

In this case I propose to check the subtabs and ignore them in the export
A part subtab can only be a body

But concretely, is it my macro that needs to be modified or is it a property to modify in SW?

Attached two methods, the first is based on the "partNumber" property if the latter is not defined for welded construction, the second is based on tabing

NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount
Dim row As Long
row = 0
For i = 0 To NumRow
    Dim itemNum As String, partnum As String
    swBOMAnnotation.GetComponentsCount2 i + 1, "", itemNum, partnum
    If isValidPart2(partnum) = False Then GoTo next_i
	For J = 0 To NumCol
            wbk.Sheets("Nomenclature").Cells(row + 9, J + 1) = swBOMAnnotation.Text(i + 1, J)
        Next J
        row = row + 1
next_i:
Next i
NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount
Dim partTab As String
Dim row As Long
row = 0
For i = 0 To NumRow
    If swBOMAnnotation.Text(i + 1, 0) = "" Then GoTo next_i
    Dim comp As Component2
    Set comp = swBOMAnnotation.GetComponents2(i + 1, "")(0)
    If isValidPart(comp, swBOMAnnotation.Text(i + 1, 0), partTab) = True Then
        For J = 0 To NumCol
            wbk.Sheets("Nomenclature").Cells(row + 9, J + 1) = swBOMAnnotation.Text(i + 1, J)
        Next J
        row = row + 1
    End If
next_i:
Next i
Function isValidPart(comp As Component2, tabulation As String, ByRef partTab As String) As Boolean
    isValidPart = True
    Dim ext As String
    ext = comp.GetPathName()
    ext = Right(ext, Len(ext) - InStrRev(ext, ".", -1, vbTextCompare))
    If ext = "SLDPRT" Then
        Dim tabNum As String
        If InStrRev(tabulation, ".", -1, vbTextCompare) <> 0 Then
            tabNum = Left(tabulation, InStrRev(tabulation, ".", -1, vbTextCompare) - 1)
        Else: tabNum = tabulation
        End If
        If tabNum = partTab Then
            isValidPart = False
        Else
            partTab = tabulation
        End If
    End If
End Function

Function isValidPart2(str As String) As Boolean
    isValidPart2 = false
    If str = "" Then Exit Function
    Dim i As Long
    For i = 1 To Len(str)
        If Mid(str, i, 1) <> " " Then
            isValidPart2 = true
            Exit Function
        End If
    Next i
End Function
2 Likes

Hello

I'm not an expert in coding at all. To have tinkered with this macro to create an excel table that works well was already a form of feat for me... But here I stall completely to understand all the subtleties.
I'm not at all sure where and how to integrate these codes into my macro.

I placed the proposed code in my macro (first method) and here it is:

You have to put the entire code in full to understand better, but here I guess it doesn't find the isValidPart Function (3rd window) called in your code, hence the sub or
Function not defined.

Paste the IsvalidPart function into the same module after the end sub and that should solve at least this problem.

Indeed, only the 2 functions were missing after the last line of the code

Hello
Thank you for the time spent to solve my problem. But I'm still stalling.
I put my complete code at the top of the discussion. I don't have the language, I'm just doing tinkering with all this^^'

Hello @Aritech
Below is the code

Sub main()

Dim xlApp As Object
Dim wbk As Object 'not Workbook
Dim sht As Object 'not Worksheet
'si nécessaire : Dim rng As Object 'not Range'

Dim swApp                   As SldWorks.SldWorks
Dim swModel                 As SldWorks.ModelDoc2
Dim swModelDocExt           As SldWorks.ModelDocExtension
Dim swBOMAnnotation         As SldWorks.BomTableAnnotation
Dim swBOMFeature            As SldWorks.BomFeature
Dim boolstatus              As Boolean
Dim BomType                 As Long
Dim Configuration           As String
Dim TemplateName            As String


Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
    swApp.SendMsgToUser2 ("Aucun assemblage actif détecté."), swMbWarning, swMbOk 'test l'activité du document
    Exit Sub
ElseIf swModel.GetType <> swDocASSEMBLY Then
    swApp.SendMsgToUser2 ("Aucun assemblage actif détecté."), swMbWarning, swMbOk 'test que le fichier est un assemblage
    Exit Sub
ElseIf swModel.GetPathName = "" Then
    swApp.SendMsgToUser2 ("Assemblage non enregistré."), swMbWarning, swMbOk 'test que l'assemblage est enregistré
    Exit Sub
End If
Set swModelDocExt = swModel.Extension

Set xlApp = CreateObject("Excel.Application")
Set wbk = xlApp.Workbooks.Open("..... Nomenclature.xlsx") ' ouverture du modèle 'ou création d'un nouveau: Set wbk = xlApp.Workbooks.Add
'si nécessaire : Sélection feuille existante: Set sht = wbk.Worksheets(1)': ajout d'une feuille de calculSet wks = wbk.Sheets.Add'
'si nécessaire : Sélection d'une cellule : Set rng = thisWs.Range("A11")'

TemplateName = "...... Détaillée.sldbomtbt" 'création de la nomenclature automatique solidworks suivant modèle'
BomType = swBomType_Indented
Configuration = "Défaut" 'nom de la configuration de l'ensemble'
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(TemplateName, 0, 0, BomType, Configuration, False, swNumberingType_Detailed, False)
Set swBOMFeature = swBOMAnnotation.BomFeature

swModel.ForceRebuild3 True

Dim NumCol As Long
Dim NumRow As Long
Dim i As Long
Dim J As Long
'''''''''''''''''''''''''''''''''''''''''''''   methode 1 '''''''''''''''''''''''''''''''''''''''''''''''''''''''
NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount
Dim row As Long
row = 0
For i = 0 To NumRow
    Dim itemNum As String, partnum As String
    swBOMAnnotation.GetComponentsCount2 i + 1, "", itemNum, partnum
    If isValidPart2(partnum) = False Then GoTo next_i
        For J = 0 To NumCol
            wbk.Sheets("Nomenclature").Cells(row + 9, J + 1) = swBOMAnnotation.Text(i + 1, J)
        Next J
        row = row + 1
next_i:
Next i
''''''''''''''''''''''''''''''''''''''''''''''   methode 2 ''''''''''''''''''''''''''''''''''''''''''''''''''''''
'NumCol = swBOMAnnotation.ColumnCount
'NumRow = swBOMAnnotation.RowCount
'Dim partTab As String
'Dim row As Long
'row = 0
'For i = 0 To NumRow
'    If swBOMAnnotation.Text(i + 1, 0) = "" Then GoTo next_i
'    Dim comp As Component2
'    Set comp = swBOMAnnotation.GetComponents2(i + 1, "")(0)
'    If isValidPart(comp, swBOMAnnotation.Text(i + 1, 0), partTab) = True Then
'        For J = 0 To NumCol
'            wbk.Sheets("Nomenclature").Cells(row + 9, J + 1) = swBOMAnnotation.Text(i + 1, J)
'        Next J
'        row = row + 1
'    End If
'next_i:
'Next i
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
boolstatus = swModelDocExt.SelectByID2(swBOMFeature.GetFeature.Description, "BOMFEATURE", 0, 0, 0, True, 0, Nothing, 0)
swModel.EditDelete

swModel.ForceRebuild3 True

Dim config As SldWorks.Configuration
Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim lRetVal As Long
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Dim nNbrProps As Long
Dim vPropNames As Variant
Dim vPropTypes As Variant
Dim vPropValues As Variant
Dim resolved As Variant
Dim custPropType As Long
Dim K As Long
Dim NomProperty1 As String
Dim NomProperty2 As String
Dim NomProperty3 As String
Dim NomProperty4 As String
Dim NomProperty5 As String
Dim NomProperty6 As String
Dim NomProperty7 As String
Dim DateStr As Date

Set config = swModel.GetActiveConfiguration ': pointe vers les propriétés solidworks du document actif
'Set cusPropMgr = config.CustomPropertyManager' : récupération des propriétés spécifiques à la configuration (Solidworks > propriétés> spécifiques à la config.
Set cusPropMgr = swModelDocExt.CustomPropertyManager("") 'récupération des propriétés personnalisées

nNbrProps = cusPropMgr.Count
vPropNames = cusPropMgr.GetNames
For K = 0 To nNbrProps - 1
    cusPropMgr.Get2 vPropNames(K), ValOut, ResolvedValOut
    custPropType = cusPropMgr.GetType2(vPropNames(K))
        If vPropNames(K) = "N° de projet" Then 'récupération de la propriété "N° de projet"'
        NomProperty1 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(1, 3) = NomProperty1
    End If
    If vPropNames(K) = "N° Plan / Réf / Dim" Then
        NomProperty2 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(1, 5) = "-" & NomProperty2
    End If
    If vPropNames(K) = "Nom de projet" Then
        NomProperty3 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(3, 3) = NomProperty3
    End If
    If vPropNames(K) = "Désignation" Then
        NomProperty4 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(5, 3) = NomProperty4
    End If
    If vPropNames(K) = "Dessinateur" Then
        NomProperty5 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(2, 7) = "   Dessinateur :   " & NomProperty5
    End If
    If vPropNames(K) = "Vérificateur" Then
        NomProperty6 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(3, 7) = "   Vérificateur :   " & NomProperty6
    End If
    If vPropNames(K) = "Indice en cours" Then
        NomProperty7 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(4, 7) = "   Indice en cours :   " & NomProperty7
    End If
Next K

wbk.Sheets("Nomenclature").Cells(1, 6) = "   Date:   " & DateValue(Now) 'extraction date du système

Dim chemin As String
chemin = Strings.Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) & "-" & NomProperty7 & " -Détaillée " & ".xlsx"  'renseignement du chemin et du nom d'enregistrement '& NomProperty : ajout d'une propriété personnalisée au nom de fichier

With xlApp
    .DisplayAlerts = False
    .EnableEvents = False
    wbk.SaveAs chemin  'enregistre le fichier et écrase si fichier déjà existant
    .DisplayAlerts = True
    .EnableEvents = True
    wbk.Close  'ferme le workbook
    .Quit  'quitte excel
End With

swApp.SendMsgToUser2 ("Nomenclature de l'ensemble de la machine créée."), swMbInformation, swMbOk 'msgbox solidworks

End Sub

Function isValidPart(comp As Component2, tabulation As String, ByRef partTab As String) As Boolean
    isValidPart = True
    Dim ext As String
    ext = comp.GetPathName()
    ext = Right(ext, Len(ext) - InStrRev(ext, ".", -1, vbTextCompare))
    If ext = "SLDPRT" Then
        Dim tabNum As String
        If InStrRev(tabulation, ".", -1, vbTextCompare) <> 0 Then
            tabNum = Left(tabulation, InStrRev(tabulation, ".", -1, vbTextCompare) - 1)
        Else: tabNum = tabulation
        End If
        If tabNum = partTab Then
            isValidPart = False
        Else
            partTab = tabulation
        End If
    End If
End Function

Function isValidPart2(str As String) As Boolean
    isValidPart2 = False
    If str = "" Then Exit Function
    Dim i As Long
    For i = 1 To Len(str)
        If Mid(str, i, 1) <> " " Then
            isValidPart2 = True
            Exit Function
        End If
    Next i
End Function

2 Likes

I have this error now!

Sub main()

Dim xlApp As Object

Dim wbk As Object 'not Workbook

Dim sht As Object 'not Worksheet

'if necessary: Dim rng As Object ‹ not Range ›

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swBOMAnnotation As SldWorks.BomTableAnnotation
Dim swBOMFeature As SldWorks.BomFeature
Dim boolstatus As Boolean
Dim BomType As Long
Dim Configuration As String
Dim TemplateName As String

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
swApp.SendMsgToUser2 (' No active assembly detected. '), swMbWarning, swMbOk' test document activity
Exit Sub
ElseIf swModel.GetType <> swDocASSEMBLY Then
swApp.SendMsgToUser2 (' No active assembly detected. '), swMbWarning, swMbOk' test that the file is an assembly
Exit Sub
ElseIf swModel.GetPathName = "  " Then
swApp.SendMsgToUser2 ( 'Unregistered Assembly. '), swMbWarning, swMbOk' test that assembly is registered
Exit Sub
End If

Set swModelDocExt = swModel.Extension

Set xlApp = CreateObject(" Excel.Application ")
Set wbk = xlApp.Workbooks.Open(" ...  Nomenclature.xls") ' opening the template ‹ or creating a new one: Set wbk = xlApp.Workbooks.Add
 ‹ if required: Existing sheet selection: Set sht = wbk. Worksheets(1) ›: added a spreadsheetSet wks = wbk. Sheets.Add ›
 ‹ if necessary: Selecting a cell: Set rng = thisWs.Range(" A11 ") ›

TemplateName = " ... Detailed.sldbomtbt » ‹ Creating the Solidworks Automatic Bill of Materials according to model ›
BomType = swBomType_Indented
Configuration = " Default" ‹ name of the set  configuration ›
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(TemplateName, 0, 0, BomType, Configuration, False, swNumberingType_Detailed, False)
Set swBOMFeature = swBOMAnnotation.BomFeature

swModel.ForceRebuild3 True

Dim NumCol As Long
Dim NumRow As Long
Sun i As Long
Sun J As Long
NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount

Dim row As Long

row = 0

For i = 0 To NumRow

Dim itemNum As String, partnum As String
swBOMAnnotation.GetComponentsCount2 i + 1, "", itemNum, partnum
If isValidPart2(partnum) = False Then GoTo next_i
    For J = 0 To NumCol
        wbk.Sheets("Nomenclature").Cells(row + 9, J + 1) = swBOMAnnotation.Text(i + 1, J)
    Next J
    row = row + 1

next_i:
Next i
boolstatus = swModelDocExt.SelectByID2(swBOMFeature.GetFeature.Description, " BOMFEATURE ", 0, 0, 0, True, 0, Nothing, 0)
swModel.EditDelete
swModel.ForceRebuild3 True

Dim config As SldWorks.Configuration
Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim lRetVal As Long
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Dim nNbrProps As Long
Dim vPropNames As Variant
Dim vPropTypes As Variant
Dim vPropValues As Variant
Dim resolved As Variant
Dim custPropType As Long
Dim K As Long
Dim PropertyName1 As String
Dim PropertyName2 As String
Dim PropertyName3 As String
Dim PropertyName4 As String
Dim PropertyName5 As String
Dim PropertyName6 As String
Dim PropertyName7 As String
Dim DateStr As Date

Set config = swModel.GetActiveConfiguration ': points to the solidworks properties of the current document
 ‹ Set cusPropMgr = config. CustomPropertyManager ›: Retrieve configuration-specific properties (Solidworks > properties> configuration-specific properties.
Set cusPropMgr = swModelDocExt.CustomPropertyManager("  ")
nNbrProps = cusPropMgr.Count
vPropNames = cusPropMgr.GetNames
For K = 0 To nNbrProps - 1

cusPropMgr.Get2 vPropNames(K), ValOut, ResolvedValOut

custPropType = cusPropMgr.GetType2(vPropNames(K))

    If vPropNames(K) = "N° de projet" Then 'récupération de la propriété "N° de projet"'

    NomProperty1 = ResolvedValOut

    wbk.Sheets("Nomenclature").Cells(1, 3) = NomProperty1

End If

If vPropNames(K) = "N° Plan / Réf / Dim" Then

    NomProperty2 = ResolvedValOut

    wbk.Sheets("Nomenclature").Cells(1, 5) = "-" & NomProperty2

End If

If vPropNames(K) = "Nom de projet" Then

    NomProperty3 = ResolvedValOut

    wbk.Sheets("Nomenclature").Cells(3, 3) = NomProperty3

End If

If vPropNames(K) = "Désignation" Then

    NomProperty4 = ResolvedValOut

    wbk.Sheets("Nomenclature").Cells(5, 3) = NomProperty4

End If

If vPropNames(K) = "Dessinateur" Then

    NomProperty5 = ResolvedValOut

    wbk.Sheets("Nomenclature").Cells(2, 7) = "   Dessinateur :   " & NomProperty5

End If

If vPropNames(K) = "Vérificateur" Then

    NomProperty6 = ResolvedValOut

    wbk.Sheets("Nomenclature").Cells(3, 7) = "   Vérificateur :   " & NomProperty6

End If

If vPropNames(K) = "Indice en cours" Then

    NomProperty7 = ResolvedValOut

    wbk.Sheets("Nomenclature").Cells(4, 7) = "   Indice en cours :   " & NomProperty7

End If

Next K

wbk. Sheets(" Nomenclature "). Cells(1, 6) = " Date: " & DateValue(Now)

Dim Path As String

path = Strings.Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) & " - " & PropertyName7 & " -Detailed " & " .xlsx " ' Fill in the path and record name ' & PropertyName: Added a custom property to the file name

With xlApp

.DisplayAlerts = False

.EnableEvents = False

wbk.SaveAs chemin  'enregistre le fichier et écrase si fichier déjà existant

.DisplayAlerts = True

.EnableEvents = True

wbk.Close  'ferme le workbook

.Quit  'quitte excel

End With

swApp.SendMsgToUser2 (" BOM of the entire machine created. "), swMbInformation, swMbOk 'msgbox solidworks

End Sub

Function isValidPart2(str As String) As Boolean

isValidPart2 = False

If str = "" Then Exit Function

Dim i As Long

For i = 1 To Len(str)

    If Mid(str, i, 1) <> " " Then

        isValidPart2 = True

        Exit Function

    End If

Next i

End Function

In general, this means that you have 2 times the same declaration, i.e. 2 times the same line with
Variable Dim
I guess you didn't erase your code before doing your copy paste because I don't have the same problem with the @Lynkoa15 code.

1 Like

If that's what you executed, you forgot to specify the paths to excel table and table model nomenclature, and as said @sbadenis check if there are no double declarations

1 Like

Indeed it goes like that.

I'll see with my different cases but there BIG THANK YOU to you.

Have a good weekend.

1 Like