Cze wszystkim
W makrze, uruchamianym z pliku części lub zespołu, otwieram skojarzony plan. Następnie tworzę nową nazwę pliku, aby zapisać ją w 2 plikach. Poniższy proces
Nie wiem, jak poradzić sobie z przełączaniem okien (krok 2 i 4)
Czy ktoś wiedziałby, jak to zrobić? Nie mogę nic znaleźć w internecie 
Z góry dziękuję 
Moim zdaniem istnieje kilka sposobów na prowadzenie swojego biznesu:
kopiowanie planu za pomocą FSO i zmienianie referencji planu
Skorzystaj z funkcji Spakuj i idź...
Czy możesz pokazać swój istniejący kod, będzie łatwiej.
W przeciwnym razie coś takiego:
Ustaw część = swApp.OpenDoc6(Plik, 3, 0, " ", longstatus, longwarnings)
Ustaw swDraw = swApp.OpenDoc6(Plik, 3, 0, " ", longstatus, longwarnings)
Otwiera część lub rysunek zgodnie z potrzebami
Do makra zaproponowanego przez @sbadenis dodałem funkcję zapobiegającą powtórce wyboru komponentów... (To stwarzało pewne problemy...)
'*****************************************************************************************************************************
'On determine si le composant selectionné fait partie d'une repetition ou non...
Dim swCompPatterned As String
swCompPatterned = swComp.IsPatternInstance() 'TRUE Si le composant fait partie d'une repetition FALSE si ce n'est pas le cas
If swCompPatterned = "Vrai" Then
MsgBox ("Erreur, le composant selectionné fait partie d'une repetition."), vbOKOnly, "Erreur -> Repetition..."
Exit Function
End If
'*****************************************************************************************************************************
Oprócz tego osobistego dodatku, to makro stało się "koniecznością" dla naszego projektu projektowego.
Pozdrowienia.
Dziękuję wszystkim za odpowiedzi.
Oto mój kod na razie. istnieje duży blok, który pozwala odtworzyć nazwę pliku, który ma zostać zapisany pod nowym indeksem (tak nie PDM 
, indeks naszych części znajduje się w nazwie pliku)
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub NouvelleRev()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim Filepath As String
Dim FileName As String
Dim FileName2 As String
Dim FileName3 As String
Dim FilepathDrw As String
Dim RevFile As String
Dim NomFichierPlan As String
Dim NomFichierPiece As String
Dim ExtFichier As String
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'******************************************************
' Contrôle du type de fichier ouvert
'******************************************************
If (swModel Is Nothing) Or (swModel.GetType = 3) Then
swApp.SendMsgToUser ("Macro utilisable à partir d'une pièce ou d'un assemblage uniquement.")
'Si mauvais format de fichier ouvert alors on ferme la macro
Exit Sub
End If
'******************************************************
' Ouverture du plan associé à la pièce/asm concerné
'******************************************************
Filepath = swModel.GetPathName
FileName = Right(Filepath, Len(Filepath) - InStrRev(Filepath, "\"))
If swModel.GetType = 1 Then 'fichier pièce
FileName2 = Replace(FileName, ".SLDPRT", ".SLDDRW")
ElseIf swModel.GetType = 2 Then 'fichier assemblage
FileName2 = Replace(FileName, ".SLDASM", ".SLDDRW")
End If
FilepathEnCours = Replace(Filepath, FileName, "")
FilepathDrw = FilepathEnCours & FileName2
'Indice du plan
If swModel.GetType = 1 Then 'fichier pièce
FileName = Replace(FileName, ".SLDPRT", "")
ElseIf swModel.GetType = 2 Then 'fichier assemblage
FileName = Replace(FileName, ".SLDASM", "")
End If
RevFile = Right(FileName, Len(FileName) - InStrRev(FileName, "-"))
'Ouverture du plan associée au document ouvert
Set Part = swApp.OpenDoc6(FilepathDrw, 3, 192, "", longstatus, longwarnings)
'******************************************************
' Nouvel Indice
'******************************************************
Dim NewRevFile As String
NewRevFile = Chr(Asc(RevFile) + 1)
'******************************************************
' Enregister sous du fichier pièce
'******************************************************
'Création du nom du fichier pour la fonction "enregistrer sous"
FileName3 = Left(FileName, 7)
If swModel.GetType = 1 Then 'fichier pièce
ExtFichier = ".SLDPRT"
ElseIf swModel.GetType = 2 Then 'fichier assemblage
ExtFichier = ".SLDASM"
End If
'Nom du fichier plan final
NomFichierPlan = FilepathEnCours & FileName3 & "-" & NewRevFile & ExtFichier
' Enregistrer sous nouvelle révision du fichier pièce
longstatus = Part.SaveAs3(NomFichier, 0, 0)
'******************************************************
' Enregister sous du fichier plan
'******************************************************
'Création du nom du fichier pour la fonction "enregistrer sous"
FileName3 = Left(FileName, 7)
Dim ExtFichierPlan As String
If swModel.GetType = 3 Then 'fichier plan
ExtFichierPlan = ".SLDDRW"
End If
'Nom du fichier plan final
NomFichierPlan = FilepathEnCours & FileName3 & "-" & NewRevFile & ExtFichierPlan
' Enregistrer sous nouvelle révision du fichier pièce
longstatus = Part.SaveAs3(NomFichier, 0, 0)
End Sub
Od razu przetestuję Twoją propozycję @sbadenis
Do podpowiedzi używam również makra, oto część, która może Cię zainteresować, nie jestem pewien, czy jest to najczystszy kod, ale jest doskonale funkcjonalny, umieszczam Ci tylko przydatną część, ponieważ mam ustawienie tylko do odczytu podpowiadanego fragmentu, ukrywam starą wskazówkę i przekazuję ją również w określonym kolorze, więc załączam Ci tylko interesującą część:
Function incrementationIndicePlan()
Debug.Print " Function incrementationIndicePlan lancé"
'on vérifie si un indice est existant et on sauvegarde l'ancien
OldIndice = Indice
Debug.Print "OldIndice:" & OldIndice
'Maj 2023-06-12 Si Indice = " " on force l'Indice pour avoir la valeur A
If Indice = "" Or Indice = " " Then
Indice = "A"
Debug.Print "Indice non existant- Indice passe à:" + Indice
Debug.Print "OldIndice:" & OldIndice
Else
Indice = Chr$(Asc(Indice) + 1)
Debug.Print "Indice:" + Indice
Debug.Print "OldIndice:" & OldIndice
End If
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
path = Filepath + Compteur + Indice + Extension
Debug.Print "Path:"; path
'On vérifie que l'indice que l'on veux créer n'existe pas déjà
If Dir(path) <> "" Then
MsgBox "Le fichier " & path & " existe déjà. Création de cet Indice refusé."
End
End If
'on modifie les propriétées Indice et Nom_Fichier
Set swCustProp = swModel.Extension.CustomPropertyManager("")
bRet = swCustProp.Add3("Indice", swCustomInfoType_e.swCustomInfoText, Indice, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
Debug.Print "Propriété Indice:" & Indice
bRet = swCustProp.Add3("Nom_Fichier", swCustomInfoType_e.swCustomInfoText, Compteur + Indice, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
'Debug.Print "Propriété Nom_Fichier:" & Compteur + Indice
'On enregistre la nouvelle pièce ou assemblage
swModel.SaveAs3 "" & path & "", 0, 0
'On vérifie l'existance de la MEP associé
PathMep = Filepath + Compteur
Debug.Print Filepath + Compteur & OldIndice; ".SLDDRW"
If Dir(PathMep & OldIndice & ".SLDDRW") <> "" Then
Call fso.CopyFile(PathMep & OldIndice & ".SLDDRW", PathMep & Indice & ".SLDDRW")
Set swApp = Application.SldWorks
'On change la référence du nouveau plan par la pièce ou assemblage avec le nouvel Indice
Call swApp.ReplaceReferencedDocument(PathMep & Indice & ".SLDDRW", PathMep & OldIndice & Extension, PathMep & Indice & Extension)
Else
Debug.Print "Pas de Mep"
End If
End Function
Cze wszystkim
Nie mogłem się z tobą skontaktować wcześniej, ale oto wynik.
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub NouvelleRev()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim Filepath As String
Dim FileName As String
Dim FileName2 As String
Dim FileName3 As String
Dim FilepathDrw As String
Dim RevFile As String
Dim FilepathEnCours As String
Dim NomFichierPlan As String
Dim NomFichierPiece As String
Dim ExtFichier As String
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'******************************************************
' Contrôle du type de fichier ouvert
'******************************************************
If (swModel Is Nothing) Or (swModel.GetType = 3) Then
swApp.SendMsgToUser ("Macro utilisable à partir d'une pièce ou d'un assemblage uniquement.")
'Si mauvais format de fichier ouvert alors on ferme la macro
Exit Sub
End If
'******************************************************
' Ouverture du plan associé à la pièce/asm concerné
'******************************************************
Filepath = swModel.GetPathName
FileName = Right(Filepath, Len(Filepath) - InStrRev(Filepath, "\"))
If swModel.GetType = 1 Then 'fichier pièce
FileName2 = Replace(FileName, ".SLDPRT", ".SLDDRW")
ElseIf swModel.GetType = 2 Then 'fichier assemblage
FileName2 = Replace(FileName, ".SLDASM", ".SLDDRW")
End If
FilepathEnCours = Replace(Filepath, FileName, "")
FilepathDrw = FilepathEnCours & FileName2
'Indice du plan
If swModel.GetType = 1 Then 'fichier pièce
FileName = Replace(FileName, ".SLDPRT", "")
ElseIf swModel.GetType = 2 Then 'fichier assemblage
FileName = Replace(FileName, ".SLDASM", "")
End If
RevFile = Right(FileName, Len(FileName) - InStrRev(FileName, "-"))
'Ouverture du plan associée au document ouvert
Set Part = swApp.OpenDoc6(FilepathDrw, 3, 1, "", longstatus, longwarnings)
If Part Is Nothing Then
MsgBox "Il n'existe pas de plan associé à ce fichier!"
Exit Sub
End If
'******************************************************
' Nouvel Indice
'******************************************************
Dim NewRevFile As String
NewRevFile = Chr(Asc(RevFile) + 1)
'******************************************************
' Enregistrement sous du fichier pièce
Set swDraw = swApp.OpenDoc6(Filepath, 1, 128, "", longstatus, longwarnings)
'Création du nom du fichier pour la fonction "enregistrer sous"
FileName3 = Left(FileName, 7)
If swModel.GetType = 1 Then 'fichier pièce
ExtFichier = ".SLDPRT"
ElseIf swModel.GetType = 2 Then 'fichier assemblage
ExtFichier = ".SLDASM"
End If
Dim NomFichier3D As String
NomFichier3D = FilepathEnCours & FileName3 & "-" & NewRevFile & ExtFichier
Dim EnregistrementFichier As Long
' Enregistrer sous nouvelle révision du fichier pièce
EnregistrementFichier = swModel.SaveAs3(NomFichier3D, 0, 0)
Call EnregistrementPlan
MsgBox "Job done!"
End Sub
Sub EnregistrementPlan()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim Filepath As String
Dim FileName As String
Dim FileName2 As String
Dim FilepathDrw As String
Dim RevFile As String
Dim FilepathEnCours As String
Dim NomFichierPlan As String
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swApp.OpenDoc6(Filepath, 3, 192, "", longstatus, longwarnings)
'Nom du fichier
Filepath = swModel.GetPathName
FileName = Right(Filepath, Len(Filepath) - InStrRev(Filepath, "\"))
FilepathEnCours = Replace(Filepath, FileName, "")
'******************************************************
' Nouvel Indice
'******************************************************
RevFile = Right(FileName, Len(FileName) - InStrRev(FileName, "-"))
Dim NewRevFile As String
NewRevFile = Chr(Asc(RevFile) + 1)
'Nom du fichier
FileName2 = Left(FileName, 7)
NomFichierPlan = FilepathEnCours & FileName2 & "-" & NewRevFile & ".SLDDRW"
Dim EnregistrementFichier As Long
EnregistrementFichier = swModel.SaveAs3(NomFichierPlan, 0, 512)
End Sub
Mój kod z całą pewnością nadaje się do optymalizacji (ale tak naprawdę nie wiem, jak to zrobić), ale ma tę zaletę, że działa.
Jeszcze raz dziękuję za pomoc