Bonjour,
Je souhaite réaliser une macro afin de copier toutes les feuilles d'une mise en plan et les renommer avec le Suffixe -SYM (sans connaître le nom des différentes feuilles)
J'ai bien trouvé ce code pour copier une feuille mais je n'arrive pas à modifier le code pour toutes les copier et renommer à l'aide d'une boucle.
'----------------------------------------------------------
' Preconditions:
' 1. Open a drawing document containing one sheet
' named Sheet1.
' 2. Open the Immediate window.
'
' Postconditions:
' 1. Activates Sheet1.
' 2. Copy and pastes Sheet1 as Sheet1(2) and activates Sheet1(2).
' 3. Copy and pastes Sheet1 as Sheet1(3) and activates Sheet1(3).
' 4. Examine the FeatureManager design tree and Immediate window.
'----------------------------------------------------------
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim Part As DrawingDoc
Dim swModel As ModelDoc2
Dim boolstatus As Boolean
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set Part = swModel
If (Part Is Nothing) Then
MsgBox " Please open a drawing document. "
End
End If
Dim currentsheet As Sheet
Set currentsheet = Part.GetCurrentSheet
Part.ActivateSheet (currentsheet.GetName)
Debug.Print "Active sheet: " & currentsheet.GetName
boolstatus = Part.Extension.SelectByID2("Feuille1", "SHEET", 0.09205356547875, 0.10872368523, 0, False, 0, Nothing, 0)
swModel.EditCopy
boolstatus = Part.PasteSheet(swInsertOption_BeforeSelectedSheet, swRenameOption_No)
Set currentsheet = Part.GetCurrentSheet
Part.ActivateSheet (currentsheet.GetName)
Debug.Print "Active sheet: " & currentsheet.GetName
boolstatus = Part.Extension.SelectByID2("Feuille1", "SHEET", 0.09205356547875, 0.10872368523, 0, False, 0, Nothing, 0)
swModel.EditCopy
boolstatus = Part.PasteSheet(swInsertOption_AfterSelectedSheet, swRenameOption_No)
Set currentsheet = Part.GetCurrentSheet
Part.ActivateSheet (currentsheet.GetName)
Debug.Print "Active sheet: " & currentsheet.GetName
End Sub
