Re: удалить дубликаты

Написал Mr.Adel в 15/03/2007 22:59:08

xm, там дали это:

Цитата:
Option Explicit

Sub MoveDuplicate()
ActiveDocument.PreserveSelection = False
Dim s As Shape
Dim stest As Shape
Optimization = True
For Each s In ActiveLayer.Shapes
If s.PositionX <> 0 And s.PositionY <> 0 Then
For Each stest In ActiveLayer.Shapes
If stest.PositionX <> 0 And stest.PositionY <> 0 Then
If stest.PositionX = s.PositionX And _
stest.PositionY = s.PositionY And _
stest.Type = s.Type And _
stest.SizeHeight = s.SizeHeight And _
stest.SizeWidth = s.SizeWidth And _
stest.StaticID <> s.StaticID Then
stest.SetPosition 0, 0
Exit For
End If
End If
Next stest
End If
Next s
Optimization = False
ActiveDocument.PreserveSelection = True
ActiveDocument.ActiveWindow.Refresh
End Sub
(Разместил пользователь kerch)


Еще дали ссылку на макрос удаляющий дубликаты, но ссылка не работает, к сожалению.

Источник: https://powerclip.ru/modules/newbb/viewtopic.php?post_id=56682

Rambler's Top100