Страницы: 1
RSS
Удаление картинок
 
День добрый.  
 
искал, переискал в инете инфу по удалению картинок макросом, нашел вот такие:  
Sub УдалениеКартинок()  
   For Each pic In ActiveSheet.Shapes  
       pic.Delete  
   Next pic  
End Sub  
 
 
Sub УдалениеКартинок_вариант2()  
   ActiveSheet.Shapes.SelectAll  
   Selection.Delete  
End Sub  
 
Второй почему-то не работает в 2003?  
 
Но эти макросы удаляют все картинки на листе, а мне хотелось бы, чтобы они удаляли картинки в столбце D. Как бы это написать, полдня мучаюсь.  
 
Спасибо.
 
Боюсь, что сложно это. Это для вас - все эти картинки находятся в столбце D, а для Excel все эти картинки находятся на невидимом слое над ячейками (слышали про слои в PhotoShop'e?)
 
понятно.  
а почему тогда 2 вариант не работает в 2003? может что дописать туда надо?
 
Не думаю, что так уж сложно. Использовать свойство Left картинки. И грохать все попадающие в диапазон. Но тут циклом.
Я сам - дурнее всякого примера! ...
 
Sub УдалениеКартинок()  
   Dim sha As Shape: Application.ScreenUpdating = False  
   For Each sha In ActiveSheet.Shapes  
       ' удаляем только картинки, у которых левый верхний угол  
       ' расположен над ячейками столбца D  
       If sha.Type = msoPicture Then If sha.TopLeftCell.Column = 4 Then sha.Delete  
   Next sha  
End Sub
 
{quote}{login=EducatedFool}{date=25.06.2010 06:47}{thema=}{post}Sub УдалениеКартинок()  
   Dim sha As Shape: Application.ScreenUpdating = False  
   For Each sha In ActiveSheet.Shapes  
       ' удаляем только картинки, у которых левый верхний угол  
       ' расположен над ячейками столбца D  
       If sha.Type = msoPicture Then If sha.TopLeftCell.Column = 4 Then sha.Delete  
   Next sha  
End Sub{/post}{/quote}  
Ну да, я пока разглагольствовал об алгоритме, мастер Йода(так, кажется учителя джидаев звали) уже готовый код выложил. Да пребудет с Вами СИЛА!:-)
Я сам - дурнее всякого примера! ...
 
Ребя, вы просто гении. Спасибо большое.
 
Sub DeleteButton()  
Dim figa As Shape  
For Each figa In ActiveSheet.Shapes  
   If Not Intersect(Range(figa.BottomRightCell.Address), Range("A10:G13")) Is Nothing Then  
       figa.Delete  
   End If  
Next  
End Sub  
удаляю картинки в диапазоне A10:G13
Страницы: 1
Читают тему
Наверх