Récupérer la valeur extension de fichier

dlebrun_1 · Février 13, 2020, 9:40

Bonjour à tous.
J'ai un petit niveau en VBA. J'ai récupéré un code que j'ai modifié suite à vos conseils sur ce forum.
En partant d'un assemblage, Il permet de faire un export de la nomenclature vers une feuille .xls
Il fonctionne parfaitement mais je souhaiterais lui ajouter la capacité de récupérer l'extension des fichiers dans la colonne : J.
La variable qui permet de récupérer l'extension est la suivante : Right(docfilename, 6)
Comment intégrer cette variable dans mon programme ?

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 = "M:\DATABASE\MODELES\05-Model de nomenclature\GP_ASM_Nomenclature BOS.sldbomtbt"
BomType = swBomType_Indented
Configuration = swApp.GetActiveConfigurationName(swModel.GetPathName)
MsgBox Configuration
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

Dim chemin As String
chemin = "C:\temp\BOS.xlsx"

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

End Sub

Cyril.f · Février 14, 2020, 7:21

Bonjour,

Il faudrait voir avec le bout de code de l'aide de l'API ci-après: http://help.solidworks.com/2019/english/api/sldworksapi/Get_Components_in_Each_BOM_Table_Row_VB.htm

stefbeno · Février 17, 2020, 7:21

Si je comprend bien, votre programme crée une nomenclature, puis la parcours pour en récupérer le contenu.

Il faudrait avoir une capture d'écran de votre nomenclature (la liste des colonnes).

Personnellement, j'ajouterai une colonne dans la nomenclature qui récupère le nom complet du fichier.
On a alors 2 possibilités :
- traiter la cellule sous vba ;
- utiliser les fonctions d'XL.

Sous VBA, vous faites une seconde boucle avec quelque chose du genre :
sht.Cells(I + 1, colonne_nom_fichier).Value = Right( sht.Cells(I + 1, colonne_nom_fichier).Value, 6)

dlebrun_1 · Février 17, 2020, 7:56

L'idée d'ajouter une colonne dans la nomenclature qui récupère le nom complet du fichier est bonne.

Malheureusement SolidWorks n'inclus pas l'option pour récupèrer le nom et l'extension du fichier.

stefbeno · Février 17, 2020, 8:59

Vu qu'il est possible via un clic-droit d'ouvrir le fichier d'une ligne de la nomenclature, vous pouvez peut-être récupérer le nom de cette manière (en simulant une ouverture) ?

L'image n'est pas lisible (c'est le problème de ce forum), il faut la mettre en pièce jointe.

dlebrun_1 · Février 17, 2020, 9:50

PJ

capture.jpg

Cyril.f · Février 17, 2020, 10:40

Bonjour,

Le lien que j'ai mis permet de boucler dans la BOM pour récupérer le chemin d'accès complet (avec extension).

dlebrun_1 · Février 17, 2020, 11:00

Cyril. Merci pour le liens. Je n'arrive pas à lance ce programme il met un message d'erreur à la 7 eme ligne.

Comment as tu fait pour le tester ? Je pense que je n'ai fait une erreur mais je n'arrive pas à savoir quoi :/

Cyril.f · Février 17, 2020, 11:32

Bonjour,

J'ai juste lancer sur un plan contenant une nomenclature. C'est à quel endroit que ça plante? (7ème ligne je ne suis pas certain d'avoir la bonne)

dlebrun_1 · Février 17, 2020, 12:22

Dans mon cas, il ne ce passe rien :O

Pourrais-tu faire un imprime écran du résultat obtenus ?

-----------------------------------

'Conditions préalables:
' 1. Ouvrez public_documents \ samples \ tutorial \ assemblyvisualize \ food_processor.sldasm.
'2. Faites un dessin à partir de l'assemblage.
'3. Sélectionnez Insertion> Tableaux> Nomenclature .
'4. Assurez-vous que l' option Pièces uniquement dans le type de nomenclature est sélectionnée.
«5. Assurez-vous que l'option Afficher les configurations de la même pièce en tant qu'éléments séparés
» dans Groupement de configuration des pièces est sélectionnée.
«6. Cliquez sur OK .
'7. Cliquez n'importe où dans le dessin pour insérer la table de nomenclature.
'
' Postconditions:
'1.Fonctionnalité Nomenclature1.
'2. Obtient la configuration par défaut .
'3. Traite la table de nomenclature pour la configuration par défaut .
'4. Examinez la fenêtre Exécution.
'
' REMARQUE : le modèle étant utilisé ailleurs, n'enregistrez pas les modifications

Cyril.f · Février 17, 2020, 3:14

Bonjour,

Ci-joint une capture.

macro_sw_get_coponent_in_bom.jpg

dlebrun_1 · Février 17, 2020, 3:53

Merci. Le resultat ce trouve dans la partie execution. Comment la faire allez dans la feuille xls ?

Cyril.f · Février 18, 2020, 8:59

Bonjour,

Ci-dessous l'intégration de l'exemple de l'API. Je n'ai pas mis de contrôle sur le fait que la variable docfilename soit vide.

Dim vPtArr As Variant
Dim swComp As Object
Dim pt As Object
Dim compPath As String
Dim docfilename As String

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 = "M:\DATABASE\MODELES\05-Model de nomenclature\GP_ASM_Nomenclature BOS.sldbomtbt"
BomType = swBomType_Indented
Configuration = swApp.GetActiveConfigurationName(swModel.GetPathName)
MsgBox Configuration
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
    vPtArr = swBOMAnnotation.GetComponents2(I, Configuration)
    If (Not IsEmpty(vPtArr)) Then
        For K = 0 To UBound(vPtArr)
            Set pt = vPtArr(K)
            Set swComp = pt
            If Not swComp Is Nothing Then
                docfilename = swComp.GetPathName
            End If
        Next K
    End If
    For J = 0 To NumCol
        sht.Cells(I + 1, J + 1).Value = swBOMAnnotation.Text(I, J)
    Next J
    If I > 0 Then
        sht.Cells(I + 1, J).Value = Right(docfilename, 6)
    End If
Next I

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

Dim chemin As String
chemin = "C:\temp\BOS.xlsx"

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

End Sub

dlebrun_1 · Février 18, 2020, 11:00

Merci pour le code :)

J'ai juste un petit problème d'erreur de compilation Li13, Col 1

Cyril.f · Février 18, 2020, 11:02

Faudrait me faire une capture du message d'erreur car Li13,Col1 chez moi c'est une ligne vide.

dlebrun_1 · Février 18, 2020, 11:10

Erratum :) Li 8, Col 1

capture.jpg

Cyril.f · Février 18, 2020, 11:23

Ce n'est pas la ligne où est le problème mais là où est le curseur.

Comme ça je dirai qu'il manque Dim K as long

Sinon à regarder dans les références (outils > References) et ça doit ressembler globalement à la capture jointe à la numéro de version près.

references_vba.jpg

dlebrun_1 · Février 19, 2020, 1:23

Cyril.f Bravo et merci :D

Cela venais effectivement de l'option : Microsoft Excel 16.0 Object Library