Macro d'extraction de nomenclature en tabulation détaillée sans les pièces soudées

Bonjour,

j’ai une macro qui fonctionne super bien pour générer un excel de mes nomenclatures, mais je n’arrive pas à exclure les pièces soudées que je ne traite jamais dans une nomenclature générale de toute la machine.
Ma nomenclature est correcte dans le plan, mais pas dans l’export.

Capture

Je crois comprendre que le dernier terme doit être en « False » mais…

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

Que faire ?

Le code donnée me semble bon. Effectivement il s’agit bien du dernier False pour cocher ou décocher la liste détaillée.
Peut-tu joindre le reste du code pour voir si l’erreur ne vient pas du reste?
Et aussi il est plus facile de lire le code lorsqu’il est insérer avec les bonnes balises.
Pour cela tu clique ici:
image

Puis tu remplaces le texte ici par ton code
2 « J'aime »


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


Bonjour @tous
De mon côté la nomenclature et lexport sont corrects,
@Aritech, vous disiez que vôtre nomenclature et correcte, pourtant la partie export ne fait que copier les cellules ! , la nomenclature n’a pas ce type de groupement de corps par hasard ?

Bonjour, merci de votre retour.

j’ai tout a fait ce type de regroupement.


ça marche dans SW, mais pas à l’export. ça va même plus loin. A l’export j’ai même le déplié des toles pliées qui ajoute une ligne vie, ce qui est inutile pour moi.
Si je comprends ce que je lis dans le topic partagé c’est que c’est un bug réglé dans le SW2022

1 « J'aime »

Dans ce cas je propose de vérifier les sous tabulation et de les ignorer dans lexport
Une sous tabulation de pièce ne peut être qu’un corps

Mais concrètement, c’est ma macro qui doit être modifiée ou c’est une propriété à modifier dans SW ?

Ci-joint deux méthode, la première se base sur la propriété « partNumber » si cette dernière nes pas définie pour les construction soudé, la deuxième se base sur la tabulation

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 « J'aime »

Bonjour,

je ne suis pas expert du tout en codage. D’avoir bidouillé cette macro pour créer un tableau excel qui va bien était déjà une forme d’exploit pour moi… mais là je cale complet pour comprendre toutes les subtilités.
je ne suis pas sûr du tout de où et comment intégrer ces codes dans ma macro.

J’ai placé le code proposé dans ma macro (première méthode) et voilà :

Il faut mettre le code en entier pour mieux comprendre mais ici je suppose qu’il ne trouve pas la Function isValidPart (3ème fenêtre) appelé dans ton code d’où le message sub ou
Function non défine.

Colle la function IsvalidPart dans le même module après le end sub et cela devrait résoudre au moins ce soucis.

Effectivement, ne manquait que les 2 fonction après la dernière ligne du code

Bonjour,
merci du temps passé pour résoudre mon problème. Mais je cale encore.
J’ai mis mon code complet en haut de discussion. J’ai pas le langage, je ne fais que de la bricole dans tout ça ^^’

Bonjour @Aritech
Ci dessous le 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 « J'aime »

J’ai cette erreur maintenant !

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 = « …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

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 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 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

En général cela veut dire que tu as 2 fois la même déclaration soit 2 fois la même ligne avec
Dim variable
Je suppose que tu n’as pas bien effacé ton code avant de faire ton copier coller car je n’ai pas le même soucis avec le code de @Lynkoa15 .

1 « J'aime »

Si c’est ce que vous avez exécuté, vous avez oublié de specifier les chemins vers table excel et table model nomenclature, et comme l a dit @sbadenis vérifiez si y’a pas double déclarations

1 « J'aime »

Effectivement ça roule comme ça.

Je vais voir avec mes différents cas de figure mais là GRAND MERCI à vous.

Bon weekend.

1 « J'aime »