bonjour,
j'ai utilisé une macro postée par un autre utilisateur.
j'ai rapidement un bug et j'avoue ne pas être spécialiste macro. Le programme plante avec une erreur de type Run-Tume error 91 (object Variable with block variable not set) au niveau de l'instruction Set swBOMFeature = swBOMAnnotation.BomFeature mise en gras
Pourriez vous m'indiquer où je fais fausse route et comment résoudre ma problématique
merci d'avance
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
Dim TableTemplate As String
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
TemplateName = "C:\Users\sal1chl\Desktop\test_nomenclature.sldbomtbt"
BomType = swBomType_TopLevelOnly
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 cusPropMgr = swModelDocExt.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