De declaratie voor swCustProp ontbreekt, door de 3 regels erboven toe te voegen werkt het wel (let op je code heeft nog een goede opschoning nodig (2x Set swModel...)
Hier is de code om op te ruimen:
Dim swModelDocExt As ModelDocExtension
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager(tConfig(i))
bRet = swCustProp.Get6("POIDS", False, sValout, sMasse, False, False)
Ik antwoord mezelf, het missen van de set van de swCustProp variabele, vandaar de fout:
Set swCustProp = swModelDocExt.CustomPropertyManager("POIDS") 'Propriété à changer si ce n'est pas celle-ci
Ja, ik bevestig dat er schoongemaakt moet worden.
Het is doe-het-zelf, ik probeer dit allemaal te begrijpen, niet gemakkelijk 
Ik heb opgeruimd en ik heb een nieuwe melding over Dim i:
(tConfig(i)) is het goed voor alle configuraties?
Hallo
Dim i moet elders in de code worden aangegeven.
Er zou de volledige code voor nodig zijn om het te begrijpen.
Het probleem is dus de overpositionering van de DIM i als gehele getallen declaratie.
Kortom, aangezien er een lijn Set swCustProp = swModelDocExt.CustomPropertyManager(tConfig(i)) aan het begin van de macro is, initieert vba de variabele i uit zichzelf.
Zij is derhalve van mening dat er sprake is van een dubbele variabeleaangifte.
Van mijn kant geef ik er de voorkeur aan om de variabeledeclaraties globaal te hebben voor alle Subs in plaats van ze in elke procedure te declareren (hangt sterk af van het gebruik van variabelen en de verschillende procedures/functies in de macro)
Je hebt ook 2 keer de swApp-aangifte, één keer boven de Sub en één keer helemaal aan het begin van de Sub.
Voordat u een aangifte doet, moet u nagaan of deze niet al bestaat.
En in het idee is het maken van de aangiften helemaal aan het begin van de sub of buiten (voor de sub) naar mijn mening schoner.
Zoiets als dit klinkt mij beter in de oren:
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim tConfig() As String
Dim swModel As SldWorks.ModelDoc2
Dim swConfigMgr As SldWorks.ConfigurationManager
Dim swConfig As SldWorks.Configuration
Dim swCustProp As CustomPropertyManager
Dim vConfigName As Variant
Dim sSpecConfigNameArr(0) As String
Dim vSpecConfigNameArr As Variant
Dim dimValue As Variant
Dim stnameConfig As String
Dim boolstatus As Boolean
Dim sMasse As String
Dim sValout As String
Dim sVal As String
Dim bRet As String
Dim swModelDocExt As ModelDocExtension
Dim i As Integer
Dim swErrors As Long
Dim swWarnings As Long
Sub main()
Set swApp = Application.SldWorks
'on récupére le document actif
Set swModel = swApp.ActiveDoc
Set swConfigMgr = swModel.ConfigurationManager
'on récupére la configuration active
Set swConfig = swConfigMgr.ActiveConfiguration
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager(tConfig(i))
stnameConfig = swConfig.Name
vConfigNameArr = swModel.GetConfigurationNames
'on boucle sur toutes les configurations
For Each vConfigName In vConfigNameArr
'on test si la configuration est différente de la configuration active et de la configuration Default
If vConfigName <> swConfig.Name And vConfigName <> "xx" Then
boolstatus = swModel.DeleteConfiguration2(vConfigName)
End If
If vConfigName <> swConfig.Name And vConfigName <> "Default" Then
boolstatus = swModel.DeleteConfiguration2(vConfigName)
End If
Next vConfigName
'on reconstruit la pièces
swModel.ForceRebuild3 False
'récupère le document actif dans SW
If Not swModel Is Nothing Then
'''-----------------------------------------------
''' lignes délplacées dans la boucle, de manière à ce que l'operation s'effectue sur tous les fichiers et pas juste le premier.
boolstatus = swModel.DeleteConfiguration2("Défaut")
boolstatus = swModel.DeleteConfiguration2("xx")
Set swPart = swModel
boolstatus = swPart.AddConfiguration2("00", "", "", True, False, False, True, 256)
boolstatus = swPart.AddConfiguration2("PC", "", "", True, False, False, True, 256)
boolstatus = swPart.AddConfiguration2("R6029", "", "", True, False, False, True, 256)
'''-----------------------------------------------
'Mise en place de la matière
swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060"
'Boucle sur toutes les configurations
tConfig = swModel.GetConfigurationNames
For i = 0 To UBound(tConfig)
'ajoute un propriété personnalisée edition avec la valeur POTEAUXHEXA"
bRet = swModel.DeleteCustomInfo2(tConfig(i), "DESIGNATION 2")
bRet = swModel.DeleteCustomInfo2(tConfig(i), "PROFILS")
bRet = swModel.AddCustomInfo3(tConfig(i), "PROFILS", swCustomInfoText, "POTEAUXHEXA")
'ajoute un propriété personnalisée edition avec la valeur Masse
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "masse")
bRet = swModel.AddCustomInfo3(tConfig(i), "masse", swCustomInfoText, Chr(34) & "SW-Mass" & Chr(34))
'ajoute un propriété personnalisée edition avec la valeur Poids
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "POIDS")
bRet = swModel.AddCustomInfo3(tConfig(i), "POIDS", swCustomInfoText, Chr(34) & "SW-Mass" & Chr(34))
'ajoute un propriété personnalisée edition avec la valeur MATERIAUX
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "MATERIAUX")
bRet = swModel.AddCustomInfo3(tConfig(i), "MATERIAUX", swCustomInfoText, Chr(34) & "SW-Material" & Chr(34))
'Récupération de la propriété de masse, changer le nom de la propriété en fonction de votre modèle
bRet = swCustProp.Get6("POIDS", False, sValout, sMasse, False, False)
'Conversion du texte en valeur décimale, multiplication x RATIO et conversion en donné de type texte
sVal = CStr(CDec(sMasse) * 0.0556)
'Création de la propriété SURFACE PIECE avec la valeur sVal
bRet = swCustProp.Add3("SURFACE PIECE", 30, sVal, 1)
Next i
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsLinearFractionDenominator, 0, 0)
boolstatus = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swUnitsLinearFeetAndInchesFormat, 0, False)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsDualLinear, 0, swLengthUnit_e.swMM)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsDualLinearFractionDenominator, 0, 0)
boolstatus = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swUnitsDualLinearFeetAndInchesFormat, 0, False)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropMass, 0, swUnitsMassPropMass_e.swUnitsMassPropMass_Kilograms)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropVolume, 0, swUnitsMassPropVolume_e.swUnitsMassPropVolume_Meters3)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsLinear, 0, swLengthUnit_e.swMM)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropLength, 0, swLengthUnit_e.swMM)
'Enregistre le docuement actif en mode silencieux
bRet = swModel.Save3(swSaveAsOptions_Silent, swErrors, swWarnings)
'Ferme le document actif
swApp.CloseDoc swModel.GetPathName
End If
End Sub
Met de code-editor is het gemakkelijker om de code te visualiseren dan om een swp-bestand ter informatie bij te voegen.
Hallo @Cyril_f @Lynkoa15 en bedankt voor je antwoorden,
Hier ben ik weer over mijn probleem dat ik vandaag opnieuw oppak.
Ik heb mijn code opgeschoond. Het was een puinhoop!
Maar ik eindig met een foutcode 91:
De debug geeft me deze regel:
Hier is mijn code, als je enig idee hebt waar de fout zit:
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swConfigMgr As SldWorks.ConfigurationManager
Dim swConfig As SldWorks.Configuration
Dim vConfigName As Variant
Dim sSpecConfigNameArr(0) As String
Dim vSpecConfigNameArr As Variant
Dim dimValue As Variant
Dim stnameConfig As String
Dim boolstatus As Boolean
Dim i As Integer
Dim swErrors As Long
Dim swWarnings As Long
Dim swPart As SldWorks.PartDoc
Dim tConfig() As String
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim sMasse As String
Dim sValout As String
Dim sVal As String
Sub main()
'''-----------------------------------------------
Set swApp = Application.SldWorks
'on récupére le document actif
Set swModel = swApp.ActiveDoc
Set swConfigMgr = swModel.ConfigurationManager
'on récupére la configuration active
Set swConfig = swConfigMgr.ActiveConfiguration
stnameConfig = swConfig.Name
vConfigNameArr = swModel.GetConfigurationNames
Set swModelDocExt = swModel.Extension
'Set swCustProp = swModelDocExt.CustomPropertyManager(tConfig(i))
Set swCustProp = swModelDocExt.CustomPropertyManager("00")
'''-----------------------------------------------
'on boucle sur toutes les configurations
For Each vConfigName In vConfigNameArr
'on test si la configuration est différente de la configuration active et de la configuration Default
If vConfigName <> swConfig.Name And vConfigName <> "xx" Then
boolstatus = swModel.DeleteConfiguration2(vConfigName)
End If
If vConfigName <> swConfig.Name And vConfigName <> "Défaut" Then
boolstatus = swModel.DeleteConfiguration2(vConfigName)
End If
Next vConfigName
'on reconstruit la pièces
swModel.ForceRebuild3 False
Do
'récupère le document actif dans SW
Set swModel = swApp.ActiveDoc
If Not swModel Is Nothing Then
''' lignes déplacées dans la boucle, de manière à ce que l'operation s'effectue sur tous les fichiers et pas juste le premier.
Set swPart = swModel
boolstatus = swPart.AddConfiguration2("00", "", "", True, False, False, True, 256)
boolstatus = swModel.DeleteConfiguration2("Défaut")
boolstatus = swModel.DeleteConfiguration2("xx")
'''-----------------------------------------------
'Mise en place de la matière
swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060"
'Boucle sur toutes les configurations
tConfig = swModel.GetConfigurationNames
For i = 0 To UBound(tConfig)
'ajoute une propriété personnalisée edition avec la valeur POTEAUXHEXA"
bRet = swModel.DeleteCustomInfo2(tConfig(i), "DESIGNATION 2")
bRet = swModel.DeleteCustomInfo2(tConfig(i), "PROFILS")
bRet = swModel.AddCustomInfo3(tConfig(i), "PROFILS", swCustomInfoText, "POTEAUXHEXA")
'ajoute un propriété personnalisée MASSE avec la valeur Masse
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "masse")
bRet = swModel.AddCustomInfo3(tConfig(i), "masse", swCustomInfoText, Chr(34) & "SW-Mass" & Chr(34))
'ajoute un propriété personnalisée POIDS avec la valeur Masse
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "POIDS")
bRet = swModel.AddCustomInfo3(tConfig(i), "POIDS", swCustomInfoText, Chr(34) & "SW-Mass" & Chr(34))
'ajoute un propriété personnalisée edition avec la valeur MATERIAUX
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "MATERIAUX")
bRet = swModel.AddCustomInfo3(tConfig(i), "MATERIAUX", swCustomInfoText, Chr(34) & "SW-Material" & Chr(34))
'Récupération de la propriété de masse, changer le nom de la propriété en fonction de votre modèle
bRet = swCustProp.Get6("POIDS", False, sValout, sMasse, False, False)
'Conversion du texte en valeur décimale, multiplication x RATIO et conversion en donné de type texte
sVal = CStr(Format(CDec(sMasse) * 0.0556, "0.000"))
'Renseignement de la propriété SURFACE PIECE avec la valeur "sVal"
bRet = swCustProp.Add3("SURFACE PIECE", 30, sVal, 1)
Next i
'Préférences SolidWorks
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsLinearFractionDenominator, 0, 0)
boolstatus = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swUnitsLinearFeetAndInchesFormat, 0, False)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsDualLinear, 0, swLengthUnit_e.swMM)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsDualLinearFractionDenominator, 0, 0)
boolstatus = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swUnitsDualLinearFeetAndInchesFormat, 0, False)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropMass, 0, swUnitsMassPropMass_e.swUnitsMassPropMass_Kilograms)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropVolume, 0, swUnitsMassPropVolume_e.swUnitsMassPropVolume_Meters3)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsLinear, 0, swLengthUnit_e.swMM)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropLength, 0, swLengthUnit_e.swMM)
'Enregistre le docuement actif en mode silencieux
bRet = swModel.Save3(swSaveAsOptions_Silent, swErrors, swWarnings)
'Ferme le document actif
swApp.CloseDoc swModel.GetPathName
End If
'boucle jusqu'a ce qu'il n'y ai plus de fichier ouvert dans SW
Loop While Not swModel Is Nothing
End Sub
Hartelijk dank
Ik antwoord mezelf. Ik zocht en zocht... 
Toen ik mijn macro voor het eerst startte, bleef deze op deze regel staan:
Ik heb het commando BEËINDIGD en in de F8-eigenschappen kon ik zien dat PROFIELEN/massa/GEWICHT en MATERIALEN goed op de hoogte waren. Het ontbrak dus SURFACE PIECE
Ik startte opnieuw op en de macro werkte tot het einde door SURFACE PIECE goed te vullen.
Alsof de macro voor het eerst werd gestart, kon deze de waarde van WEIGHT die net daarvoor is berekend niet ophalen.
Dus ik heb een deel reconstructie toegevoegd tussen MATERIALEN en het herstel van massa-eigendom en het werkt. 
Ik heb mijn macro getest met een enkele configuratiecreatie en de SURFACE PIECE was correct.
Vervolgens heb ik mijn macro getest door de creatie van 3 configuraties te integreren: 00 / PC / R1018.
SURFACE PIECE is goed gemaakt in de 3 configuraties, maar ik krijg maar een goed berekeningsresultaat op één configuratie.
Heb je een idee van het probleem?
Hier is de code:
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swConfigMgr As SldWorks.ConfigurationManager
Dim swConfig As SldWorks.Configuration
Dim vConfigName As Variant
Dim sSpecConfigNameArr(0) As String
Dim vSpecConfigNameArr As Variant
Dim dimValue As Variant
Dim stnameConfig As String
Dim boolstatus As Boolean
Dim i As Integer
Dim swErrors As Long
Dim swWarnings As Long
Dim swPart As SldWorks.PartDoc
Dim tConfig() As String
Dim swModelDocExt As ModelDocExtension
Dim swCustProp As CustomPropertyManager
Dim sMasse As String
Dim sValout As String
Dim sVal As String
Sub main()
'''-----------------------------------------------
Set swApp = Application.SldWorks
'on récupére le document actif
Set swModel = swApp.ActiveDoc
Set swConfigMgr = swModel.ConfigurationManager
'on récupére la configuration active
Set swConfig = swConfigMgr.ActiveConfiguration
stnameConfig = swConfig.Name
vConfigNameArr = swModel.GetConfigurationNames
Set swModelDocExt = swModel.Extension
'''-----------------------------------------------
'on boucle sur toutes les configurations
For Each vConfigName In vConfigNameArr
'on test si la configuration est différente de la configuration active et de la configuration Default
If vConfigName <> swConfig.Name And vConfigName <> "xx" Then
boolstatus = swModel.DeleteConfiguration2(vConfigName)
End If
If vConfigName <> swConfig.Name And vConfigName <> "Défaut" Then
boolstatus = swModel.DeleteConfiguration2(vConfigName)
End If
Next vConfigName
'on reconstruit la pièces
swModel.ForceRebuild3 False
Do
'récupère le document actif dans SW
Set swModel = swApp.ActiveDoc
If Not swModel Is Nothing Then
''' lignes déplacées dans la boucle, de manière à ce que l'operation s'effectue sur tous les fichiers et pas juste le premier.
Set swPart = swModel
boolstatus = swPart.AddConfiguration2("00", "", "", True, False, False, True, 256)
boolstatus = swPart.AddConfiguration2("PC", "", "", True, False, False, True, 256)
boolstatus = swPart.AddConfiguration2("R1018", "", "", True, False, False, True, 256)
boolstatus = swModel.DeleteConfiguration2("Défaut")
boolstatus = swModel.DeleteConfiguration2("xx")
'''-----------------------------------------------
'Mise en place de la matière
swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060"
'Boucle sur toutes les configurations
tConfig = swModel.GetConfigurationNames
For i = 0 To UBound(tConfig)
'ajoute une propriété personnalisée edition avec la valeur POTEAUXHEXA"
bRet = swModel.DeleteCustomInfo2(tConfig(i), "DESIGNATION 2")
bRet = swModel.DeleteCustomInfo2(tConfig(i), "PROFILS")
bRet = swModel.AddCustomInfo3(tConfig(i), "PROFILS", swCustomInfoText, "POTEAUXHEXA")
'ajoute un propriété personnalisée MASSE avec la valeur Masse
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "masse")
bRet = swModel.AddCustomInfo3(tConfig(i), "masse", swCustomInfoText, Chr(34) & "SW-Mass" & Chr(34))
'ajoute un propriété personnalisée POIDS avec la valeur Masse
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "POIDS")
bRet = swModel.AddCustomInfo3(tConfig(i), "POIDS", swCustomInfoText, Chr(34) & "SW-Mass" & Chr(34))
'ajoute un propriété personnalisée edition avec la valeur MATERIAUX
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "MATERIAUX")
bRet = swModel.AddCustomInfo3(tConfig(i), "MATERIAUX", swCustomInfoText, Chr(34) & "SW-Material" & Chr(34))
'on reconstruit la pièces
swModel.ForceRebuild3 False
Set swCustProp = swModelDocExt.CustomPropertyManager(tConfig(i))
'Récupération de la propriété de masse, changer le nom de la propriété en fonction de votre modèle
bRet = swCustProp.Get6("POIDS", False, sValout, sMasse, False, False)
'Conversion du texte en valeur décimale, multiplication x RATIO et conversion en donné de type texte
sVal = CStr(Format(CDec(sMasse) * 0.0556, "0.000"))
'Renseignement de la propriété SURFACE PIECE avec la valeur "sVal"
bRet = swCustProp.Add3("SURFACE PIECE", 30, sVal, 1)
Next i
'Préférences SolidWorks
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsLinearFractionDenominator, 0, 0)
boolstatus = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swUnitsLinearFeetAndInchesFormat, 0, False)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsDualLinear, 0, swLengthUnit_e.swMM)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsDualLinearFractionDenominator, 0, 0)
boolstatus = swModel.Extension.SetUserPreferenceToggle(swUserPreferenceToggle_e.swUnitsDualLinearFeetAndInchesFormat, 0, False)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropMass, 0, swUnitsMassPropMass_e.swUnitsMassPropMass_Kilograms)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropVolume, 0, swUnitsMassPropVolume_e.swUnitsMassPropVolume_Meters3)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsLinear, 0, swLengthUnit_e.swMM)
boolstatus = swModel.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropLength, 0, swLengthUnit_e.swMM)
'Enregistre le docuement actif en mode silencieux
bRet = swModel.Save3(swSaveAsOptions_Silent, swErrors, swWarnings)
'Ferme le document actif
swApp.CloseDoc swModel.GetPathName
End If
'boucle jusqu'a ce qu'il n'y ai plus de fichier ouvert dans SW
Loop While Not swModel Is Nothing
End Sub
Ik antwoord mezelf nog een keer!
Ik heb de macro gewijzigd door aan het begin alleen configuratie 00 te maken en vervolgens alle eigenschappen in te vullen.
Ten slotte maak ik alle andere configuraties, die de eigenschappen van de oorspronkelijke configuratie overnemen.
JIPPIE!!!
Bedankt voor de hulp. Het is me gelukt om met je advies rond te komen.