Bonjour à tous, je vais expliquer ce que je fais, et en arriver à ma question:
Actuellement j'ai 2000 fichiers à traiter et 10000 "rechercher / remplacer" de valeurs d'attributs dans des blocs.
Pour le moment, je fais (pour chaque fichier) un attout, j'ouvre cela sous excell, je lance une routine Microsoft visual basic pour applications, j'enregistre le .txt et je fais un attin.
C'est long et fastidieux, je me suis mis en quête de:
Un lisp (.lsp) ou un script (.SCR) me permettant de désigner un dossier de dwg, exporter tous les attributs de blocs de l'espace objet (un par un), faire un Rechercher/Remplacer dans ce texte (Liste de couples fournie en xls ou txt ou peu importe), et réimporter cela dans le dwg (par attin par exemple). Et BATCH!
Auriez vous quelque chose sous le coude qui permet de faire cela? Y a t il une autre méthode plus simple?
Voici le code visual basic pour Rechercher/Remplacer dans excell: (Ce code est une partie repris d'un forum "extendoffice" sur internet, auquel j'ai demandé à ChatGPT de le compléter pour: trouver la liste des couples dans un fichier externe / une feuille / une plage, et définir la plage d'origine automatiquement sans sélection et marquer en VERT les valeurs d'attributs modifiées après le script).
Sub MultiFindNReplace()
Dim Rng As Range
Dim InputRng As Range, ReplaceRange As Range
Dim ModifiedCells As Range ' Plage de cellules modifiées
On Error Resume Next ' Ignorer les erreurs si aucune cellule n'est modifiée
' Sélectionnez la plage d'origine
'Set InputRng = Application.Selection
'Set InputRng = Application.InputBox("Original Range ", "KutoolsforExcel", InputRng.Address, Type:=8)
Set InputRng = ActiveSheet.UsedRange
' Sélectionnez la plage de remplacement
Dim wb As Workbook
Set wb = Workbooks.Open("C:\Users\gricatti\DOCS\01-PRODUCTION\Liste equipements.xlsx")
Set ReplaceRange = wb.Sheets("Formatage 070").Range("$C$2:$D$95")
Application.ScreenUpdating = False
' Parcours de la plage de remplacement
For Each Rng In ReplaceRange.Columns(1).Cells
' Recherche et remplace dans la plage d'origine
InputRng.Replace What:=Rng.Value, Replacement:=Rng.Offset(0, 1).Value, LookAt:=xlWhole, MatchCase:=False
' Vérifier si une cellule a été modifiée
Dim FoundCell As Range
Set FoundCell = InputRng.Find(What:=Rng.Offset(0, 1).Value, LookAt:=xlWhole, MatchCase:=False)
If Not FoundCell Is Nothing Then
' Ajouter la cellule modifiée à la plage des cellules modifiées
If ModifiedCells Is Nothing Then
Set ModifiedCells = FoundCell
Else
Set ModifiedCells = Application.Union(ModifiedCells, FoundCell)
End If
End If
Next
' Appliquer la couleur de fond verte aux cellules modifiées
If Not ModifiedCells Is Nothing Then
ModifiedCells.Interior.Color = RGB(0, 255, 0) ' Couleur verte
End If
Application.ScreenUpdating = True
On Error GoTo 0 ' Réactiver la gestion des erreurs
End Sub
Le titre du sujet a été modifié par un modérateur pour faciliter la recherche. Titre original:
Automatiser attout-rechercher remplacer-attin
Résolu ! Accéder à la solution.
