Export nomenclature vers Excel

Bonjour à tous,

le but est de créer automatiquement via une macro VBA une nomemclature dans un assemblage, exporter cette dernière vers un fichier Excel dont le nom sera le nom fichier pièce + une proprété personalisée. Enfin la macro doit supprimerla nomenclature créée.

Nous ne disposons pas des outils My Cad - Solidworks Prenium

Bonjour,

 

Sa ressemble beaucoup à une annonce de travail lol

 

Sinon as tu commencé a regardé du coté de l'enregistreur de macro ?

 

Cordialement

Bonjour,

tu as déjà un bout de code à nous montré ? 

Dimitri.

1 Like

Bonjour,

Regarde la macro jointe, normalement tout y est (un peu en vrac et sans controle de sécurité). Change au moins les lignes :

TemplateName = "Z:\Model_SW\Nomenclature.sldbomtbt"

Configuration = "Défaut"

If vPropNames(K) = "DESSINATEUR" Then

Pour mettre le chemin vers ton modèle de nomenclature, le nom de ta configuration par défaut dans tes asm et le nom de ta propriété personalisée que tu veux dans le nom du fichier.

Cordialement,


insert-bom-asm.swp
2 Likes

Merci pour ta réponse d.roger, la macro fonctionne, seul petit problème, quand je mets la propriété personalisé là ou te me l'as indiqué  la valeur de la propriété n'est pas renvoyée dans le nom fichier. J'ai l'impression que la ligne créant le nom du fichier dans la macro, il n'ya aps de rappelle de la propiété, j'ai essayé de la rajouté mais les test ne sont pas concluant de ce côté.

Bonjour,

Il faut que tu remplaces les 2 lignes :

Set config = swModel.GetActiveConfiguration

Set cusPropMgr = config.CustomPropertyManager

qui récupèrent la valeur demandée dans la configuration active par :

Set cusPropMgr = swModelDocExt.CustomPropertyManager("")

qui récupérera la valeur dans l'onglet "Personnaliser"

Cordialement,

5 Likes

Parfait en réalisant cette modification la macro fontionne comme je le voulais. Juste pour amélioration est-il possible d'enregistrer le tableur dans le meme dossier que l'assemblage.

Bonjour,

Oui c'est possible, tu remplace la ligne :

chemin = Environ("USERPROFILE") & "\Desktop\" & Left(swModel.GetTitle, Len(swModel.GetTitle) - 7) & "-" & NomProperty & ".xlsx"

par :

chemin = Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) & "-" & NomProperty & ".xlsx"

Cordialement,

1 Like

Bonjour,

Si tu veux aussi donner un peu de mise en page à ton fichier Excel, tu peux ajouter des lignes comme par exemple :

​

NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount

xlApp.Worksheets(xlApp.ActiveSheet.Name).Rows(1).RowHeight = 40
For I = 1 To NumRow - 1
    xlApp.Worksheets(xlApp.ActiveSheet.Name).Rows(I + 1).RowHeight = 20
Next I
For J = 0 To NumCol - 1
    xlApp.Worksheets(xlApp.ActiveSheet.Name).Columns(J + 1).ColumnWidth = 25
    xlApp.ActiveSheet.Cells(1, J + 1).Interior.ColorIndex = 15
Next J

For I = 0 To NumRow - 1
    For J = 0 To NumCol - 1
        xlApp.ActiveSheet.Cells(I + 1, J + 1).NumberFormat = "@"
        xlApp.ActiveSheet.Cells(I + 1, J + 1).VerticalAlignment = 2
        sht.Cells(I + 1, J + 1).Value = swBOMAnnotation.Text(I, J)
    Next J
Next I​

En lieu et place de :

NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount

For I = 0 To NumRow
    For J = 0 To NumCol
        sht.Cells(I + 1, J + 1).Value = swBOMAnnotation.Text(I, J)
    Next J
Next I

la ligne :

xlApp.ActiveSheet.Cells(I + 1, J + 1).NumberFormat = "@"

est particulièrement interressante si tu as des valeurs numérique commençant par 0 car cela met la cellule Excel au format texte et évite donc de perdre le 0 du début.

Cordialement,

1 Like

Bonjour,

Avant tout, merci pour ce partage, c'est vraiment génial de trouver ici des infos de cette qualité !

Je suis en train d'essayer de paramétrer la macro d'export de nomenclatures ; malheureusement je ne parviens pas à la faire fonctionner.

J'ai message "Erreur d'éxecution 91 Variable objet ou variable de bloc with non définie" sur les lignes suivantes :

Set swBOMAnnotation = swModelDocExt.InsertBomTable3(TemplateName, 0, 0, BomType, Configuration, False, swNumberingType_Detailed, True)
Set swBOMFeature = swBOMAnnotation.BomFeature

 

Avez-vous une idée de ce qui pourrait poser problème ?

Merci d'avance !

Bonjour,

le hasard justement c'est que je travail sur de la nomenclature automatique est cette macro arrive juste à point. J'ai juste un souci c'est qu'elle récupère les informations sur des pièces de  premier niveau et non sur des pièces dans un  assemblages ou sous assemblage de sous assemblage d'assemblage etc..

il y at il une solution?

merci

que la force soit avec vous.

 

1 Like

Bonjour OBI WAN,

Oui il y a une solution, tu remplace la ligne "BomType = swBomType_TopLevelOnly" par "BomType = swBomType_Indented", cela devrait te mettre la nomenclature en multi-niveau.

Cordialement,

1 Like

Bonjour s.descamps,

As-tu bien remplacé le chemin d'accès à ton modèle de nomenclature dans la ligne "TemplateName = "Z:\Model_SW\Nomenclature.sldbomtbt"" ?

Ou encore le nom de la configuration par une configuration valide dans la ligne "Configuration = "Défaut"" ?

Cordialement,

1 Like

Bonjour,  yes @ d.roger  c'est nickel.

un grand merci à toi :)

la force est avec toi.

 

2 Likes

Bonjour,

Je n’arrive pas a télécharger la macro mentionner par @d.roger :cry:
Es ce que quelqu’un sait pourquoi ?

Merci d’avance !

Bonjour,
Je pense que c’est lié au fait que le fichier est sur l’ancien url du site. Pas sécurisé donc du coup le navigateur bloque (en tout cas c’est ce qu’il se passe chez moi)

Bonjour;

Je n’ai pas de problèmes pour la télécharger (Firefox ?) la voici (de nouveau):
insert-bom-asm.swp (77,5 Ko)

et si vraiment cela ne marche pas, voici la version « Tapuscrit »:

Option Explicit

Sub main()

Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
Dim wbk As Excel.Workbook
Dim sht As Excel.Worksheet

With xlApp
    .Visible = True
    Set wbk = .Workbooks.Add
    Set sht = wbk.ActiveSheet
End With

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
Set swModelDocExt = swModel.Extension

TemplateName = "Z:\Model_SW\Nomenclature.sldbomtbt"
BomType = swBomType_TopLevelOnly
Configuration = "Défaut"
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(TemplateName, 0, 0, BomType, Configuration, False, swNumberingType_Detailed, True)
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
        sht.Cells(I + 1, J + 1).Value = swBOMAnnotation.Text(I, J)
    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 NomProperty As String

Set config = swModel.GetActiveConfiguration
Set cusPropMgr = config.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) = "DESSINATEUR" Then
        NomProperty = ResolvedValOut
    End If
Next K

Dim chemin As String
chemin = Environ("USERPROFILE") & "\Desktop\" & swModel.GetTitle & "-" & NomProperty & ".xls"

With xlApp
    wbk.SaveAs chemin
    wbk.Close
    .Quit
End With

End Sub


Cordialement.

1 Like

Bonjour,

Sur ce lien ça fonctionne. Sur celui d’origine sur Edge ça génère une erreur liée à la sécurité du téléchargement.

:grin:Ben ça alors…y’a des gens qui utilisent « Edge » !!! :grin:

1 Like

Pas le choix :wink:

3 Likes