Dim swApp                       As SldWorks.SldWorks
Sub main()

'*******************************************************
'Déclarations

Dim swSelMgr                    As SldWorks.SelectionMgr
Dim swAssy                      As SldWorks.AssemblyDoc
Dim swCompEnt                   As Object
Dim swModel                     As SldWorks.ModelDoc2
Dim Assy                      As SldWorks.AssemblyDoc
Dim Comp As SldWorks.Component2
Dim bRet                        As Long
Dim bstatus As Boolean
Dim piecebis As String
Dim stnewfilename As String
Dim name As String
'*******************************************************

'#######################################################
'Définition des variables de pièces.
name = InputBox("Entrez le nom de la pièce de remplacement" & vbCrLf & "exemple: 00-XXXXX-0-Pièce")
NouvellePiece = InputBox("Entrez le chemin de la pièce de remplacement" & vbCrLf & " exemple: C:\PDM\11 SIMULATION\01 Etuyeuse continue\Introduction produit\")
swNewfile = NouvellePiece & name
stnewfilename = InputBox("entrez le nom de la pièce à selectionner ainsi que son numéro dans l'arbre" & vbCrLf & "00-XXXXX-0-Piece-3" & vbCrLf & "'-3' étant ici l'indice que Piece est la troisième exemplaire dans l'arbre")
'#######################################################


'#######################################################
'Selection et remplacement de la pièce.

Set swApp = CreateObject("Sldworks.application")
Set swModel = swApp.ActiveDoc
Set Assy = swModel

swModel.ClearSelection2 True
bstatus = swModel.Extension.SelectByID2(stnewfilename & "@SE-XXXXX-0-Trajectoire", "COMPONENT", 0, 0, 0, True, 0, Nothing, 0)

bstatus = swModel.ReplaceComponents(swNewfile, "", True, True)
swModel.ClearSelection2 True
'#######################################################


End Sub