Een stuklijstmacro bewerken

Out of category
1

Hallo

Ik ben geïnteresseerd in deze macro waarmee je met één klik een Excel-stuklijst kunt maken van een assembly, maar ik wil deze graag wijzigen zodat deze een Excel-sjabloon gebruikt waarin ik een aantal dingen heb ingesteld (macro waarmee je de eigenschappen in SW kunt wijzigen, lijst met vervolgkeuzelijsten)

Hier is de code voor de originele macro:

Option Explicit

Dim swApp                   As SldWorks.SldWorks
Dim swModel                 As SldWorks.AssemblyDoc
Dim swModelDocExt           As SldWorks.ModelDocExtension
Dim swBOMAnnotation         As SldWorks.BomTableAnnotation
Dim swBOMFeature            As SldWorks.BomFeature
Dim BomType                 As Long
Dim Configuration           As String
Dim TemplateName            As String
Dim swConfig                As SldWorks.Configuration
Dim xlApp                   As Excel.Application
Dim wbk                     As Excel.Workbook
Dim sht                     As Excel.Worksheet
Dim NumCol                  As Long
Dim NumRow                  As Long
Dim I                       As Long
Dim J                       As Long
Dim chemin                  As String

Sub xls()
    ' On ouvre un nouvel objet Excel
    Set xlApp = New Excel.Application
    
    ' On rend Excel visible avec un nouveau classeur
    With xlApp
        .Visible = True
        Set wbk = .Workbooks.Add
        Set sht = wbk.ActiveSheet
    End With
    
    ' On se raccroche à l'application SW
    Set swApp = Application.SldWorks

    ' On se raccroche au document SW ouvert
    Set swModel = swApp.ActiveDoc
    Set swModelDocExt = swModel.Extension
    
    ' On définit le modèle de nomenclature
    TemplateName = "Z:\BIBLIO\BIBLIO_LOGICIEL\BIBLIO_SOLIDWORKS\SOLIDWORKS_FORMALISME_CLEO\Modèle de nomenclature\9999_Nomenclature_SW.sldbomtbt"
    BomType = swBomType_Indented
    
    ' On récupère la configuration active
    Set swConfig = swModel.GetActiveConfiguration
    Configuration = swConfig.Name
    
    ' On insère la nomenclature dans le 3D
    Set swBOMAnnotation = swModelDocExt.InsertBomTable3(TemplateName, 0, 1, BomType, Configuration, False, swNumberingType_Detailed, True)
    Set swBOMFeature = swBOMAnnotation.BomFeature
    
    ' On reconstruit le 3D
    swModel.ForceRebuild3 True
    
    ' On remplit les cellules de Excel à partir des valeurs de la nomenclature
    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
    
    ' On définit le nom complet du fichier Excel
    chemin = Environ("USERPROFILE") & "\Desktop\" & "export" & ".xls"
    
    ' On sauvegarde le fichier Excel puis on ferme Excel
    With xlApp
        wbk.SaveAs chemin
        wbk.Close
        .Quit
    End With
 
End Sub

 

Ik stel me voor dat het gedeelte dat moet worden gewijzigd het volgende is,

Dim wbk                     As Excel.Workbook

 

of

 

' On ouvre un nouvel objet Excel
    Set xlApp = New Excel.Application
    
    ' On rend Excel visible avec un nouveau classeur
    With xlApp
        .Visible = True
        Set wbk = .Workbooks.Add
        Set sht = wbk.ActiveSheet
    End With

 

maar ik weet niet hoe ik het pad van mijn XLS-model moet aangeven

Bedankt voor je hulp

 

 

 

 

2

In een tweede stap wil ik ook andere wijzigingen aanbrengen, zoals

  1. - Noteer de stuklijst op dezelfde plaats als de assemblage waarvan deze is afgeleid
  2. - Schrijf de nomenclatuur twee keer: in het tabblad Werk, maar ook in een tweede tabblad, als back-up
  3. - voeg een miniatuur toe van het deel voor elke regel (alleen mogelijk vanaf 2019? Ik werk momenteel in 2018) (ik zal later een specifieke positie openen, ik heb al een codebase die ik niet aan het werk krijg)
  4. Exporteer alle eigenschappen van alle configuraties automatisch (post gewijd aan deze vraag hier)
  5. - exporteer in deze Excel-tabel ook de SW-eigenschap die de promotie van componenten in de uitsluitingsmodus beheert... (Ik zal later een specifieke positie openen)

Voor zover mogelijk natuurlijk...

Bij voorbaat dank voor uw suggesties

1 like
3

Hallo

Op de vraag "hoe geef ik het pad van mijn xls-model aan" moet je de regel vervangen

Stel wbk in = . Werkmappen.Toevoegen

bij

Stel wbk in = . Werkmappen.Open("C:\..........\mijn modèle.xls")

Op de vraag "bewaar de stuklijst op dezelfde plaats als de assemblage waar deze vandaan komt" moeten we de regel vervangen

path = Over ("GEBRUIKERSPROFIEL") & "\Desktop\" & "exporteren" & ".xls"

bij

ExcelName dimmen als tekenreeks
ExcelName = swModel.GetPathName()
ExcelName = Links(ExcelName, InStrRev(ExcelName, "\"))
path = ExcelName & "exporteren" & ".xls"

Aan de vraag "schrijf de nomenclatuur twee keer: in het tabblad werk, maar ook in een tweede tabblad, als back-up" kun je bijvoorbeeld een regel toevoegen

Dim shtOpslaan als Excel.Werkblad

Na de regel

Dim sht als Excel.Werkblad

Voeg vervolgens de regel toe

Stel shtSave in = wbk. Werkbladen(2)

Na de regel

Stel sht in = wbk. Actief blad

en voeg ten slotte de regel toe

shtSave.Cells (I + 1, J + 1). Waarde = swBOMAnnotatie.Tekst(I, J)

Na de regel

Sht. Cellen (I + 1, J + 1). Waarde = swBOMAnnotatie.Tekst(I, J)

Voor vragen 3, 4 en 5: aansluitende of specifieke discussiedraad ...

Vriendelijke groeten

 

2 likes