Edycja makra zestawienia komponentów

Out of category
1

Witam

Interesuje mnie to makro , które pozwala na stworzenie zestawienia materiałowego w Excelu z zestawu za pomocą jednego kliknięcia, ale chciałbym je zmodyfikować tak, aby korzystało z szablonu excela, w którym ustawiłem kilka rzeczy (makro pozwalające na modyfikację właściwości w SW, lista rozwijanych opcji)

Oto kod oryginalnego makra:

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

 

Wyobrażam sobie, że sekcja do modyfikacji jest następująca:

Dim wbk                     As Excel.Workbook

 

lub

 

' 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

 

ale nie wiem, jak wskazać ścieżkę mojego modelu XLS

Dziękuję za pomoc

 

 

 

 

2

W drugim kroku chciałbym również wprowadzić inne zmiany, takie jak

  1. - Zapisz BOM w tym samym miejscu, co zespół, z którego pochodzi
  2. - Napisz nomenklaturę dwa razy: w zakładce Praca, ale także w drugiej zakładce, jako kopię zapasową
  3. - dołącz miniaturę części przed każdą linią (możliwe tylko od 2019 roku? W tej chwili pracuję w 2018 roku) (później otworzę konkretne stanowisko, mam już bazę kodu, której nie mogę zmusić do pracy)
  4. Eksportuj automatycznie wszystkie właściwości wszystkich konfiguracji (post poświęcony temu pytaniu tutaj)
  5. - wyeksportuj również w tej tabeli Excela właściwość SW, która zarządza promocją komponentów w trybie wykluczania... (Później otworzę konkretne stanowisko)

O ile to możliwe, oczywiście...

Z góry dziękuję za sugestie

1 polubienie
3

Witam

Na pytanie "jak mam wskazać ścieżkę mojego modelu xls" musisz zamienić linię

Ustaw wbk = . Skoroszyty.Dodaj

przez

Ustaw wbk = . Skoroszyty.Open("C:\..........\mój modèle.xls")

Na pytanie "zapisz zestawienie materiałów w tym samym miejscu co zespół, z którego pochodzi" musimy wymienić linię

path = About("USERPROFILE") & "\Desktop\" & "eksportuj" & ".xls"

przez

Dim ExcelName As Ciąg
ExcelName = swModel.GetPathName()
NazwaExcela = Lewo(NazwaProgramu, InStrRev(NazwaProgramu, "\"))
path = NazwaExcela & "eksport" & ".xls"

Do pytania "napisz nomenklaturę dwa razy: w zakładce praca, ale też w drugiej zakładce, jako zapas" możesz np. dodać linijkę

Dim shtZapisz jako Excel.Arkusz roboczy

Po linii

Dim sht As Excel.Arkusz roboczy

Następnie dodaj wiersz

Ustaw shtSave = wbk. Arkusze robocze(2)

Po linii

Ustaw sht = wbk. Arkusz ActiveSheet

i na koniec dodaj linię

shtSave.Cells(I + 1, J + 1). Wartość = swBOMAnnotation.Text(I, J)

Po linii

Arkuszy. Komórki(I + 1, J + 1). Wartość = swBOMAnnotation.Text(I, J)

W przypadku pytań 3, 4 i 5: kolejny lub dedykowany wątek dyskusji ...

Pozdrowienia

 

2 polubienia