Anwenden eines Makros auf einen gesamten Ordner

Macro
1

Hallo

Ich möchte das folgende Makro, das gut funktioniert, auf alle Clips anwenden, die in einem Ordner gespeichert sind.

Ich habe mehrere erfolglose Versuche unternommen, da ich weiß, dass ich Anfänger bin und versuche, bestehende Modelle zu kopieren.

Vielen Dank im Voraus für Ihre Antwort


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 „Gefällt mir“
3

Hallo
Sie können dies mit Integration tun, wenn Sie über die MyCadTools verfügen.

Wenn nicht mit dem Code, müssen Sie damit beginnen.

4

Vielen Dank, dass ich die MyCadTools-Integration verwendet habe

1 „Gefällt mir“