Appliquer une macro à tout un dossier

Macro
1

Bonjour,

Je souhaiterai appliquer la macro suivante qui fonctionne bien à tous les plans stockés dans un dossier.

J'ai fai plusieurs essais sans succès sachant que je débute et j'essaye de copier des modèles existants.

Merci d'avance de vos réponse


2022-04-29_15h07_54.png
2 

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Public CheckCurV As String
Dim RevTable As Object
Dim CurrentRevision As String

Sub MAIN()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc


  
' Get Current Revision
  CheckCurV = Part.CustomInfo2("", "Current Revision")
  
  
' Get Revision Table
  Set RevTable = Part.GetCurrentSheet.RevisionTable
  If RevTable Is Nothing Then MsgBox "No revision table is available!", vbExclamation: End

' Add Row to Revision Table
  RevTable.AddRevision (CheckCurV)
    nNumCol = RevTable.ColumnCount - 4
    'nNumRow = RevTable.RowCount - 1

' Interface to add values to new row on the Revision Table
  RevTable.Text(0, nNumCol) = "28.04.22" 'InputBox("Date." & Chr$(13) & Chr$(13) & "| *REV* |Description|Rev By|Date|" & Chr$(13) & "____________________________________________" & Chr$(13), "Revision", CheckCurV)

  'RevTable.Text(0, nNumCol + 1) = InputBox("Enter the Revision number or letter." & Chr$(13) & Chr$(13) & "| *REV* |Description|Rev By|Date|" & Chr$(13) & "____________________________________________" & Chr$(13), "Revision", CheckCurV)

  RevTable.Text(0, nNumCol + 2) = "Changement de matiere en 441" 'InputBox("Enter the description of the revision." & Chr$(13) & Chr$(13) & "|Rev| *DESCRIPTION* |Rev By|Date|" & Chr$(13) & "____________________________________________", "Description", "ECO- ")

  RevTable.Text(0, nNumCol + 3) = "YP" 'InputBox("Enter the revision creator's initials." & Chr$(13) & Chr$(13) & "|Rev|Description| *REV BY* |Date|" & Chr$(13) & "____________________________________________", "Rev By", "IP")

' Apply new value for Current Revision
  Part.CustomInfo2("", "Current Revision") = RevTable.Text(nNumRow, nNumCol)

' Force Rebuild
  boolstatus = Part.ForceRebuild3(False)

End Sub

 

1 « J'aime »
3

Salut,
Tu peux le faire avec Intégration si tu as les MyCadTools.

Sinon par le code, il faut commencer par cela.

4

Merci j'ai utilisé Intégration de MyCadTools

1 « J'aime »