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
