Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Невидимость фигур и рисунков - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Невидимость фигур и рисунков (Макросы/Sub)
Невидимость фигур и рисунков
Glass4217 Дата: Суббота, 16.02.2019, 14:30 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 55
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Здравствуйте.
Нашел в инете файл xls
В нем макрос - делает невидимыми объекты стоящие к фигуре, указанной в ячейке K3 дальше 100 единиц - невидимыми.

Но рисунки все равно остаются видимыми.
Подскажите - как изменить макрос, чтобы он делал невидимыми не только фигуры, но и рисунки тоже ?
К сообщению приложен файл: 6696855.xls (87.0 Kb)
 
Ответить
СообщениеЗдравствуйте.
Нашел в инете файл xls
В нем макрос - делает невидимыми объекты стоящие к фигуре, указанной в ячейке K3 дальше 100 единиц - невидимыми.

Но рисунки все равно остаются видимыми.
Подскажите - как изменить макрос, чтобы он делал невидимыми не только фигуры, но и рисунки тоже ?

Автор - Glass4217
Дата добавления - 16.02.2019 в 14:30
krosav4ig Дата: Суббота, 16.02.2019, 15:34 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2346
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте.
как-то так, наверное
[vba]
Код
Sub Макрос1()
    Dim shps As Shapes, shp As Shape
    Dim i As Long, x1, x2, y1, y2
    Set shps = ActiveSheet.Shapes
    Set shp = ActiveSheet.Shapes([k3])
    x2 = shp.Left + shp.Width / 2
    y2 = shp.Top + shp.Height / 2
    For i = 1 To shps.Count
        With shps(i)
            If Not (Intersect(.TopLeftCell, [B4:S45]) Is Nothing Or Intersect(.BottomRightCell, [B4:S45]) Is Nothing) Then
            x1 = .Left + .Width / 2
            y1 = .Top + .Height / 2
            .Fill.Transparency = -(((x2 - x1) ^ 2 + (y2 - y1) ^ 2) ^ 0.5 > 100)
            .Line.Transparency = .Fill.Transparency
            If .Type = msoPicture Then .Visible = .Fill.Transparency = 0
            End If
        End With
    Next i
End Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте.
как-то так, наверное
[vba]
Код
Sub Макрос1()
    Dim shps As Shapes, shp As Shape
    Dim i As Long, x1, x2, y1, y2
    Set shps = ActiveSheet.Shapes
    Set shp = ActiveSheet.Shapes([k3])
    x2 = shp.Left + shp.Width / 2
    y2 = shp.Top + shp.Height / 2
    For i = 1 To shps.Count
        With shps(i)
            If Not (Intersect(.TopLeftCell, [B4:S45]) Is Nothing Or Intersect(.BottomRightCell, [B4:S45]) Is Nothing) Then
            x1 = .Left + .Width / 2
            y1 = .Top + .Height / 2
            .Fill.Transparency = -(((x2 - x1) ^ 2 + (y2 - y1) ^ 2) ^ 0.5 > 100)
            .Line.Transparency = .Fill.Transparency
            If .Type = msoPicture Then .Visible = .Fill.Transparency = 0
            End If
        End With
    Next i
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 16.02.2019 в 15:34
Glass4217 Дата: Воскресенье, 17.02.2019, 02:01 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 55
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
krosav4ig, большое спасибо.
Теперь картинки тоже исчезают.
 
Ответить
Сообщениеkrosav4ig, большое спасибо.
Теперь картинки тоже исчезают.

Автор - Glass4217
Дата добавления - 17.02.2019 в 02:01
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Невидимость фигур и рисунков (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!