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

Вход

Регистрация

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

 

= Мир MS Excel/Сокрытие-отображение шейпов по названию - Мир MS Excel

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

Excel 2013
Здравствуйте.
Подскажите как поправить макрос.

Он должен делать видимыми или невидимыми фигуры со словом в названии "плюс" или "минус".
Но не работает - выдает ошибку 400.
Как его изменить, чтобы он скрывал-отображал эти шейпы на листе ?
[vba]
Код

Sub МакросВидимостиВклВыкл()
Dim i As Long
For i = 1 To ActiveSheet.Shapes.Count
    If i = 1 Then
        ActiveSheet.Shapes.Range(Array("плюс " & i)).Visible = False
    Else
        ActiveSheet.Shapes.Range(Array("плюс " & i)).Visible = _
        ActiveSheet.Shapes.Range(Array("плюс " & i)).Visible
    End If
Next i

For i = 1 To ActiveSheet.Shapes.Count
    If i = 1 Then
        ActiveSheet.Shapes.Range(Array("минус " & i)).Visible = False
    Else
        ActiveSheet.Shapes.Range(Array("минус " & i)).Visible = _
        ActiveSheet.Shapes.Range(Array("минус " & i)).Visible
    End If
Next i

End Sub
[/vba]
К сообщению приложен файл: 68678.xlsb (15.6 Kb)


Сообщение отредактировал bazanski - Понедельник, 27.11.2023, 10:19
 
Ответить
СообщениеЗдравствуйте.
Подскажите как поправить макрос.

Он должен делать видимыми или невидимыми фигуры со словом в названии "плюс" или "минус".
Но не работает - выдает ошибку 400.
Как его изменить, чтобы он скрывал-отображал эти шейпы на листе ?
[vba]
Код

Sub МакросВидимостиВклВыкл()
Dim i As Long
For i = 1 To ActiveSheet.Shapes.Count
    If i = 1 Then
        ActiveSheet.Shapes.Range(Array("плюс " & i)).Visible = False
    Else
        ActiveSheet.Shapes.Range(Array("плюс " & i)).Visible = _
        ActiveSheet.Shapes.Range(Array("плюс " & i)).Visible
    End If
Next i

For i = 1 To ActiveSheet.Shapes.Count
    If i = 1 Then
        ActiveSheet.Shapes.Range(Array("минус " & i)).Visible = False
    Else
        ActiveSheet.Shapes.Range(Array("минус " & i)).Visible = _
        ActiveSheet.Shapes.Range(Array("минус " & i)).Visible
    End If
Next i

End Sub
[/vba]
Автор - bazanski
Дата добавления - 27.11.2023 в 10:14
msi2102 Дата: Понедельник, 27.11.2023, 11:22 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 414
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Пробуйте
[vba]
Код
Sub Макрос()
    Dim i As Integer, myShape As Shape, m As Boolean
    Set sd = CreateObject("Scripting.Dictionary")
    i = 0
        For Each myShape In ActiveSheet.Shapes
            If InStr(myShape.Name, "Плюс") > 0 Or InStr(myShape.Name, "Минус") > 0 Then If Not sd.Exists(myShape.Name) Then i = i + 1: sd.Add i, myShape.Name
        Next
    m = IIf(ActiveSheet.Shapes(sd(1)).Visible, False, True)
    ActiveSheet.Shapes.Range(sd.Items).Visible = m
End Sub
[/vba]
К сообщению приложен файл: 3672238.xlsb (18.7 Kb)
 
Ответить
СообщениеПробуйте
[vba]
Код
Sub Макрос()
    Dim i As Integer, myShape As Shape, m As Boolean
    Set sd = CreateObject("Scripting.Dictionary")
    i = 0
        For Each myShape In ActiveSheet.Shapes
            If InStr(myShape.Name, "Плюс") > 0 Or InStr(myShape.Name, "Минус") > 0 Then If Not sd.Exists(myShape.Name) Then i = i + 1: sd.Add i, myShape.Name
        Next
    m = IIf(ActiveSheet.Shapes(sd(1)).Visible, False, True)
    ActiveSheet.Shapes.Range(sd.Items).Visible = m
End Sub
[/vba]
Автор - msi2102
Дата добавления - 27.11.2023 в 11:22
bazanski Дата: Понедельник, 27.11.2023, 11:37 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 24
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
msi2102, спасибо.
Но не работает

Выдает ошибку "Comple error : Variable not defined"
И подсвечивает участок кода: "sd ="
 
Ответить
Сообщениеmsi2102, спасибо.
Но не работает

Выдает ошибку "Comple error : Variable not defined"
И подсвечивает участок кода: "sd ="
Автор - bazanski
Дата добавления - 27.11.2023 в 11:37
msi2102 Дата: Понедельник, 27.11.2023, 11:50 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 414
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Попробуйте так
[vba]
Код
Sub Макрос()
Dim i As Integer, myShape As Shape, m As Boolean, sd As Object
Set sd = CreateObject("Scripting.Dictionary")
i = 0
For Each myShape In ActiveSheet.Shapes
If InStr(myShape.Name, "Плюс") > 0 Or InStr(myShape.Name, "Минус") > 0 Then If Not sd.Exists(myShape.Name) Then i = i + 1: sd.Add i, myShape.Name
Next
m = ActiveSheet.Shapes(sd(1)).Visible
ActiveSheet.Shapes.Range(sd.Items).Visible = Not m
End Sub
[/vba]
К сообщению приложен файл: 0548029.xlsb (18.7 Kb)


Сообщение отредактировал msi2102 - Понедельник, 27.11.2023, 11:57
 
Ответить
СообщениеПопробуйте так
[vba]
Код
Sub Макрос()
Dim i As Integer, myShape As Shape, m As Boolean, sd As Object
Set sd = CreateObject("Scripting.Dictionary")
i = 0
For Each myShape In ActiveSheet.Shapes
If InStr(myShape.Name, "Плюс") > 0 Or InStr(myShape.Name, "Минус") > 0 Then If Not sd.Exists(myShape.Name) Then i = i + 1: sd.Add i, myShape.Name
Next
m = ActiveSheet.Shapes(sd(1)).Visible
ActiveSheet.Shapes.Range(sd.Items).Visible = Not m
End Sub
[/vba]
Автор - msi2102
Дата добавления - 27.11.2023 в 11:50
msi2102 Дата: Понедельник, 27.11.2023, 11:53 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 414
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Необходимо подключить в редакторе VBA ссылку на библиотеку Microsoft Scripting Runtime, если она еще не подключена (в меню Tools–>References…)
 
Ответить
СообщениеНеобходимо подключить в редакторе VBA ссылку на библиотеку Microsoft Scripting Runtime, если она еще не подключена (в меню Tools–>References…)
Автор - msi2102
Дата добавления - 27.11.2023 в 11:53
msi2102 Дата: Понедельник, 27.11.2023, 12:07 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 414
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
А так можно чередовать, плюс видимый, минус не видимый и наоборот
[vba]
Код
Sub Макрос()
    Dim i As Integer, j As Integer, myShape As Shape, m As Boolean, sd As Object
    Set sd = CreateObject("Scripting.Dictionary")
    Set sd("Плюс") = CreateObject("Scripting.Dictionary")
    Set sd("Минус") = CreateObject("Scripting.Dictionary")
    i = 0:    j = 0
        For Each myShape In ActiveSheet.Shapes
            If InStr(myShape.Name, "Плюс") > 0 Then If Not sd("Плюс").Exists(myShape.Name) Then i = i + 1: sd("Плюс").Add i, myShape.Name
            If InStr(myShape.Name, "Минус") > 0 Then If Not sd("Минус").Exists(myShape.Name) Then j = j + 1: sd("Минус").Add j, myShape.Name
        Next
    m = ActiveSheet.Shapes(sd("Плюс")(1)).Visible
    ActiveSheet.Shapes.Range(sd("Плюс").Items).Visible = Not m
    ActiveSheet.Shapes.Range(sd("Минус").Items).Visible = m
End Sub
[/vba]
К сообщению приложен файл: 1765254.xlsb (19.0 Kb)
 
Ответить
СообщениеА так можно чередовать, плюс видимый, минус не видимый и наоборот
[vba]
Код
Sub Макрос()
    Dim i As Integer, j As Integer, myShape As Shape, m As Boolean, sd As Object
    Set sd = CreateObject("Scripting.Dictionary")
    Set sd("Плюс") = CreateObject("Scripting.Dictionary")
    Set sd("Минус") = CreateObject("Scripting.Dictionary")
    i = 0:    j = 0
        For Each myShape In ActiveSheet.Shapes
            If InStr(myShape.Name, "Плюс") > 0 Then If Not sd("Плюс").Exists(myShape.Name) Then i = i + 1: sd("Плюс").Add i, myShape.Name
            If InStr(myShape.Name, "Минус") > 0 Then If Not sd("Минус").Exists(myShape.Name) Then j = j + 1: sd("Минус").Add j, myShape.Name
        Next
    m = ActiveSheet.Shapes(sd("Плюс")(1)).Visible
    ActiveSheet.Shapes.Range(sd("Плюс").Items).Visible = Not m
    ActiveSheet.Shapes.Range(sd("Минус").Items).Visible = m
End Sub
[/vba]
Автор - msi2102
Дата добавления - 27.11.2023 в 12:07
bazanski Дата: Понедельник, 27.11.2023, 12:32 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 24
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
msi2102, Спасибо.
Не работает.

Выдает ошибку:
System Error &H80070057 (-2147024809). Параметр задан неверно.
 
Ответить
Сообщениеmsi2102, Спасибо.
Не работает.

Выдает ошибку:
System Error &H80070057 (-2147024809). Параметр задан неверно.
Автор - bazanski
Дата добавления - 27.11.2023 в 12:32
msi2102 Дата: Понедельник, 27.11.2023, 13:18 | Сообщение № 8
Группа: Проверенные
Ранг: Обитатель
Сообщений: 414
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Попробуйте так
[vba]
Код
Sub Макрос()
    Dim i As Integer, j As Integer, myShape As Shape, m As Boolean, sd As Object
    Set sd = CreateObject("Scripting.Dictionary")
    Set sd("Плюс") = CreateObject("Scripting.Dictionary")
    Set sd("Минус") = CreateObject("Scripting.Dictionary")
    i = 0:    j = 0
        For Each myShape In ActiveSheet.Shapes
            If InStr(1, myShape.Name, "Плюс", 1) > 0 Then If Not sd("Плюс").Exists(myShape.Name) Then i = i + 1: sd("Плюс").Add i, myShape.Name
            If InStr(1, myShape.Name, "Минус", 1) > 0 Then If Not sd("Минус").Exists(myShape.Name) Then j = j + 1: sd("Минус").Add j, myShape.Name
        Next
    If sd("Плюс").Count = 0 Then MsgBox "На листе отсутствуют фигуры в имени которых содержится ""Плюс""": Exit Sub
    If sd("Минус").Count = 0 Then MsgBox "На листе отсутствуют фигуры в имени которых содержится ""Минус""": Exit Sub
    m = ActiveSheet.Shapes(sd("Плюс")(1)).Visible
    ActiveSheet.Shapes.Range(sd("Плюс").Items).Visible = Not m
    ActiveSheet.Shapes.Range(sd("Минус").Items).Visible = m
End Sub
[/vba]
К сообщению приложен файл: 7464139.xlsb (19.7 Kb)
 
Ответить
СообщениеПопробуйте так
[vba]
Код
Sub Макрос()
    Dim i As Integer, j As Integer, myShape As Shape, m As Boolean, sd As Object
    Set sd = CreateObject("Scripting.Dictionary")
    Set sd("Плюс") = CreateObject("Scripting.Dictionary")
    Set sd("Минус") = CreateObject("Scripting.Dictionary")
    i = 0:    j = 0
        For Each myShape In ActiveSheet.Shapes
            If InStr(1, myShape.Name, "Плюс", 1) > 0 Then If Not sd("Плюс").Exists(myShape.Name) Then i = i + 1: sd("Плюс").Add i, myShape.Name
            If InStr(1, myShape.Name, "Минус", 1) > 0 Then If Not sd("Минус").Exists(myShape.Name) Then j = j + 1: sd("Минус").Add j, myShape.Name
        Next
    If sd("Плюс").Count = 0 Then MsgBox "На листе отсутствуют фигуры в имени которых содержится ""Плюс""": Exit Sub
    If sd("Минус").Count = 0 Then MsgBox "На листе отсутствуют фигуры в имени которых содержится ""Минус""": Exit Sub
    m = ActiveSheet.Shapes(sd("Плюс")(1)).Visible
    ActiveSheet.Shapes.Range(sd("Плюс").Items).Visible = Not m
    ActiveSheet.Shapes.Range(sd("Минус").Items).Visible = m
End Sub
[/vba]
Автор - msi2102
Дата добавления - 27.11.2023 в 13:18
bazanski Дата: Понедельник, 27.11.2023, 13:42 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 24
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
msi2102, появляется надпись.
На листе отсутствуют фигуры в имени которых содержится ""Плюс"

(это в вашем же файле такая ошибка выдается)


Сообщение отредактировал bazanski - Понедельник, 27.11.2023, 13:43
 
Ответить
Сообщениеmsi2102, появляется надпись.
На листе отсутствуют фигуры в имени которых содержится ""Плюс"

(это в вашем же файле такая ошибка выдается)
Автор - bazanski
Дата добавления - 27.11.2023 в 13:42
msi2102 Дата: Понедельник, 27.11.2023, 13:50 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 414
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
А вы проверьте, существуют фигуры в имени которых присутствует слово "Плюс". А лучше создайте фигуру с именем в котором будет содержаться слово "Плюс", например "Плюс 1111". Сейчас скачал мой же файл и у меня всё отрабатывает корректно.
 
Ответить
СообщениеА вы проверьте, существуют фигуры в имени которых присутствует слово "Плюс". А лучше создайте фигуру с именем в котором будет содержаться слово "Плюс", например "Плюс 1111". Сейчас скачал мой же файл и у меня всё отрабатывает корректно.
Автор - msi2102
Дата добавления - 27.11.2023 в 13:50
bazanski Дата: Понедельник, 27.11.2023, 13:55 | Сообщение № 11
Группа: Пользователи
Ранг: Новичок
Сообщений: 24
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Цитата msi2102, 27.11.2023 в 11:50, в сообщении № 4 ()
Попробуйте так
Sub Макрос()
Dim i As Integer, myShape As Shape, m As Boolean, sd As Object
Set sd = CreateObject("Scripting.Dictionary")
i = 0
For Each myShape In ActiveSheet.Shapes
If InStr(myShape.Name, "Плюс") > 0 Or InStr(myShape.Name, "Минус") > 0 Then If Not sd.Exists(myShape.Name) Then i = i + 1: sd.Add i, myShape.Name
Next
m = ActiveSheet.Shapes(sd(1)).Visible
ActiveSheet.Shapes.Range(sd.Items).Visible = Not m
End Sub

К сообщению приложен файл: 0548029.xlsb (18.7 Kb)


Вот этот вроде работает.
Подскажите как при появлении шейпов (включении у них свойства Visible) - поставить у них появление свойства "на передний план" (ZOrder msoBringToFront) ?


Сообщение отредактировал bazanski - Понедельник, 27.11.2023, 14:11
 
Ответить
Сообщение
Цитата msi2102, 27.11.2023 в 11:50, в сообщении № 4 ()
Попробуйте так
Sub Макрос()
Dim i As Integer, myShape As Shape, m As Boolean, sd As Object
Set sd = CreateObject("Scripting.Dictionary")
i = 0
For Each myShape In ActiveSheet.Shapes
If InStr(myShape.Name, "Плюс") > 0 Or InStr(myShape.Name, "Минус") > 0 Then If Not sd.Exists(myShape.Name) Then i = i + 1: sd.Add i, myShape.Name
Next
m = ActiveSheet.Shapes(sd(1)).Visible
ActiveSheet.Shapes.Range(sd.Items).Visible = Not m
End Sub

К сообщению приложен файл: 0548029.xlsb (18.7 Kb)


Вот этот вроде работает.
Подскажите как при появлении шейпов (включении у них свойства Visible) - поставить у них появление свойства "на передний план" (ZOrder msoBringToFront) ?
Автор - bazanski
Дата добавления - 27.11.2023 в 13:55
msi2102 Дата: Понедельник, 27.11.2023, 14:17 | Сообщение № 12
Группа: Проверенные
Ранг: Обитатель
Сообщений: 414
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Цитата bazanski, 27.11.2023 в 13:55, в сообщении № 11 ()
"на передний план"
[vba]
Код
ActiveSheet.Shapes.Range(sd("Плюс").Items).ZOrder msoBringForward
[/vba]
 
Ответить
Сообщение
Цитата bazanski, 27.11.2023 в 13:55, в сообщении № 11 ()
"на передний план"
[vba]
Код
ActiveSheet.Shapes.Range(sd("Плюс").Items).ZOrder msoBringForward
[/vba]
Автор - msi2102
Дата добавления - 27.11.2023 в 14:17
bazanski Дата: Понедельник, 27.11.2023, 14:24 | Сообщение № 13
Группа: Пользователи
Ранг: Новичок
Сообщений: 24
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
msi2102, не работает.
Выдает ошибку : Object requires


Сообщение отредактировал bazanski - Понедельник, 27.11.2023, 14:28
 
Ответить
Сообщениеmsi2102, не работает.
Выдает ошибку : Object requires
Автор - bazanski
Дата добавления - 27.11.2023 в 14:24
msi2102 Дата: Понедельник, 27.11.2023, 14:27 | Сообщение № 14
Группа: Проверенные
Ранг: Обитатель
Сообщений: 414
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Извиняюсь, для макроса в 11 сообщении
[vba]
Код
ActiveSheet.Shapes.Range(sd.Items).ZOrder msoBringForward
[/vba]


Сообщение отредактировал msi2102 - Понедельник, 27.11.2023, 14:28
 
Ответить
СообщениеИзвиняюсь, для макроса в 11 сообщении
[vba]
Код
ActiveSheet.Shapes.Range(sd.Items).ZOrder msoBringForward
[/vba]
Автор - msi2102
Дата добавления - 27.11.2023 в 14:27
bazanski Дата: Понедельник, 27.11.2023, 14:28 | Сообщение № 15
Группа: Пользователи
Ранг: Новичок
Сообщений: 24
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
msi2102, теперь все заработало.
Спасибо
 
Ответить
Сообщениеmsi2102, теперь все заработало.
Спасибо
Автор - bazanski
Дата добавления - 27.11.2023 в 14:28
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сокрытие-отображение шейпов по названию (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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