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

Вход

Регистрация

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

 

= Мир MS Excel/Автоматическое снятие фильтра после закрытия файла - Мир MS Excel

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

Excel 2016
Здравствуйте,

Скажите, пожалуйста, имеется ли возможность прописать через VBA такую опцию, как:
- автоматическое снятие всех фильтров в документе после закрытия файла;
- автоматическое сложение (закрытие) все сгруппированных областей после закрытия файла;

В документе уже имею VBA скрипт на "запароливание" документа при закрытии, может его можно как-то дополнить, чтобы вышеупомянутые опции работали?

[vba]
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
For Each sh In ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4""))
    With sh
        .Unprotect "password"
        .Protect Password:="password", Userinterfaceonly:=True, Scenarios:=True, AllowFiltering:=True
    End With
Next
End Sub
[/vba]
Заранее благодарен за помощь!


Сообщение отредактировал KIMVSR - Понедельник, 04.04.2016, 14:19
 
Ответить
СообщениеЗдравствуйте,

Скажите, пожалуйста, имеется ли возможность прописать через VBA такую опцию, как:
- автоматическое снятие всех фильтров в документе после закрытия файла;
- автоматическое сложение (закрытие) все сгруппированных областей после закрытия файла;

В документе уже имею VBA скрипт на "запароливание" документа при закрытии, может его можно как-то дополнить, чтобы вышеупомянутые опции работали?

[vba]
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
For Each sh In ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4""))
    With sh
        .Unprotect "password"
        .Protect Password:="password", Userinterfaceonly:=True, Scenarios:=True, AllowFiltering:=True
    End With
Next
End Sub
[/vba]
Заранее благодарен за помощь!

Автор - KIMVSR
Дата добавления - 04.04.2016 в 14:19
SLAVICK Дата: Понедельник, 04.04.2016, 14:32 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
Пробуйте так:
[vba]
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim sh As Worksheet
For Each sh In ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4"))
    On Error Resume Next
    With sh
        .ShowAllData 'снятие всех фильтров
        .Outline.ShowLevels RowLevels:=1, ColumnLevels:=1 'сгруппирование
        .Unprotect "password"
        .Protect Password:="password", Userinterfaceonly:=True, Scenarios:=True, AllowFiltering:=True
    End With
Next
End Sub
[/vba]


Иногда все проще чем кажется с первого взгляда.
 
Ответить
СообщениеПробуйте так:
[vba]
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim sh As Worksheet
For Each sh In ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4"))
    On Error Resume Next
    With sh
        .ShowAllData 'снятие всех фильтров
        .Outline.ShowLevels RowLevels:=1, ColumnLevels:=1 'сгруппирование
        .Unprotect "password"
        .Protect Password:="password", Userinterfaceonly:=True, Scenarios:=True, AllowFiltering:=True
    End With
Next
End Sub
[/vba]

Автор - SLAVICK
Дата добавления - 04.04.2016 в 14:32
_Boroda_ Дата: Понедельник, 04.04.2016, 14:35 | Сообщение № 3
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Такой вариант. И да, Ким, это все происходит не после закрытия, а до. И еще - Ваш кусок кода нужно вешать на открытие, о чем Андрей ниже и пишет.
[vba]
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    For Each sh In ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4"))
        With sh
            .ShowAllData
            .Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
            .Unprotect "password"
            .Protect Password:="password", Userinterfaceonly:=True, Scenarios:=True, AllowFiltering:=True
        End With
    Next
End Sub
[/vba]
Добавлено
Что-то мы с Ярославом сегодня друг дружку повторяем.
http://www.excelworld.ru/forum/2-22612-182272-16-1459762032


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеТакой вариант. И да, Ким, это все происходит не после закрытия, а до. И еще - Ваш кусок кода нужно вешать на открытие, о чем Андрей ниже и пишет.
[vba]
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    For Each sh In ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4"))
        With sh
            .ShowAllData
            .Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
            .Unprotect "password"
            .Protect Password:="password", Userinterfaceonly:=True, Scenarios:=True, AllowFiltering:=True
        End With
    Next
End Sub
[/vba]
Добавлено
Что-то мы с Ярославом сегодня друг дружку повторяем.
http://www.excelworld.ru/forum/2-22612-182272-16-1459762032

Автор - _Boroda_
Дата добавления - 04.04.2016 в 14:35
RAN Дата: Понедельник, 04.04.2016, 15:26 | Сообщение № 4
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
[vba]
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
[/vba]
[vba]
Код
Userinterfaceonly:=True
[/vba]
Это как раз то, чего в супе не хватает! :D


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение[vba]
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
[/vba]
[vba]
Код
Userinterfaceonly:=True
[/vba]
Это как раз то, чего в супе не хватает! :D

Автор - RAN
Дата добавления - 04.04.2016 в 15:26
KIMVSR Дата: Вторник, 05.04.2016, 12:37 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 118
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
SLAVICK, _Boroda_, спасибо ребят, всё отлично работает! Огромное спасибо за помощь!

Единственное, скроллбары не сдвигаются вверх и влево после закрытия и сохранения. Т.е. если я сдвину скроллбары так, что таблицу вообще не будет видно и затем сохранюсь - при открытии таблица будет выглядеть именно так, как я её оставил. Эти скроллбары возможно как-то через VBA прописать, чтобы они в нулевую позицию возвращались?

И еще - Ваш кусок кода нужно вешать на открытие, о чем Андрей ниже и пишет.

Саш, на самом деле тот кусок кода у меня висит и на открытие, и на закрытие:
[vba]
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    For Each sh In ThisWorkbook.Sheets(Array("Sheet1", "Sheet2"))
        With sh
            .ShowAllData
            .Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
            .Unprotect "password"
            .Protect Password:="password", Userinterfaceonly:=True, Scenarios:=True, AllowFiltering:=True
        End With
    Next
End Sub

Private Sub Workbook_Open()
For Each sh In ThisWorkbook.Sheets(Array("Sheet1", "Sheet2"))
    With sh
        .Unprotect "password"
        .Protect Password:="password", Scenarios:=True, AllowFiltering:=True
        .EnableOutlining = True
    End With
Next
End Sub
[/vba]
Т.е. теперь код выглядит вот так. Работает так, как надо! :P

RAN, ваш намёк понял, исправил! Спасибо! :D


Сообщение отредактировал KIMVSR - Вторник, 05.04.2016, 13:11
 
Ответить
СообщениеSLAVICK, _Boroda_, спасибо ребят, всё отлично работает! Огромное спасибо за помощь!

Единственное, скроллбары не сдвигаются вверх и влево после закрытия и сохранения. Т.е. если я сдвину скроллбары так, что таблицу вообще не будет видно и затем сохранюсь - при открытии таблица будет выглядеть именно так, как я её оставил. Эти скроллбары возможно как-то через VBA прописать, чтобы они в нулевую позицию возвращались?

И еще - Ваш кусок кода нужно вешать на открытие, о чем Андрей ниже и пишет.

Саш, на самом деле тот кусок кода у меня висит и на открытие, и на закрытие:
[vba]
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    For Each sh In ThisWorkbook.Sheets(Array("Sheet1", "Sheet2"))
        With sh
            .ShowAllData
            .Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
            .Unprotect "password"
            .Protect Password:="password", Userinterfaceonly:=True, Scenarios:=True, AllowFiltering:=True
        End With
    Next
End Sub

Private Sub Workbook_Open()
For Each sh In ThisWorkbook.Sheets(Array("Sheet1", "Sheet2"))
    With sh
        .Unprotect "password"
        .Protect Password:="password", Scenarios:=True, AllowFiltering:=True
        .EnableOutlining = True
    End With
Next
End Sub
[/vba]
Т.е. теперь код выглядит вот так. Работает так, как надо! :P

RAN, ваш намёк понял, исправил! Спасибо! :D

Автор - KIMVSR
Дата добавления - 05.04.2016 в 12:37
SLAVICK Дата: Вторник, 05.04.2016, 14:23 | Сообщение № 6
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
. Эти скроллбары возможно как-то через VBA прописать, чтобы они в нулевую позицию возвращались?

Можно:
[vba]
Код
.Cells(1, "a").Select
[/vba]
Если есть закрепленные области - тогда сложнее нужно активировать ячейку ниже закрепленной строки и правее закрепленного столбца.


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
. Эти скроллбары возможно как-то через VBA прописать, чтобы они в нулевую позицию возвращались?

Можно:
[vba]
Код
.Cells(1, "a").Select
[/vba]
Если есть закрепленные области - тогда сложнее нужно активировать ячейку ниже закрепленной строки и правее закрепленного столбца.

Автор - SLAVICK
Дата добавления - 05.04.2016 в 14:23
KIMVSR Дата: Вторник, 05.04.2016, 14:30 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 118
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
SLAVICK, закреплённые области есть: ячейка ниже закреплённой строки и правее закреплённого столбца получается G8 и на другом листе F8.

Скажите, пожалуйста, что обозначает этот код данные внутри скобок? Выбор ячейки A1?
Я прописал предложенный вами код на закрытие таким образом:
[vba]
Код
.Cells(8, "G").Select
[/vba]
Можно как-то в эту строчку добавить Sheet1 и Sheet2, если у меня разные ячейки, на которые я хочу ссылаться?
Sheet1 G8 и Sheet2 F8,

И огромное вам спасибо за помощь!!! yes


Сообщение отредактировал KIMVSR - Вторник, 05.04.2016, 14:35
 
Ответить
СообщениеSLAVICK, закреплённые области есть: ячейка ниже закреплённой строки и правее закреплённого столбца получается G8 и на другом листе F8.

Скажите, пожалуйста, что обозначает этот код данные внутри скобок? Выбор ячейки A1?
Я прописал предложенный вами код на закрытие таким образом:
[vba]
Код
.Cells(8, "G").Select
[/vba]
Можно как-то в эту строчку добавить Sheet1 и Sheet2, если у меня разные ячейки, на которые я хочу ссылаться?
Sheet1 G8 и Sheet2 F8,

И огромное вам спасибо за помощь!!! yes

Автор - KIMVSR
Дата добавления - 05.04.2016 в 14:30
SLAVICK Дата: Вторник, 05.04.2016, 14:37 | Сообщение № 8
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
то обозначает этот код данные внутри скобок? Выбор ячейки A1?

Так точно :D
если листов немного - тогда можно прописать условия для каждого, если много - самую правую и самую нижнюю ячейки.
Т.е. для
G8 и на другом листе F8.

[vba]
Код
.Cells(8, "f").Select
[/vba]
Можно как-то в эту строчку добавить Sheet1 и Sheet2, если у меня разные ячейки

[vba]
Код
        .Unprotect "password"
        If .Name = "Sheet1" Then .Cells(8, "g").Select Else .Cells(8, "f").Select
[/vba]


Иногда все проще чем кажется с первого взгляда.

Сообщение отредактировал SLAVICK - Вторник, 05.04.2016, 14:46
 
Ответить
Сообщение
то обозначает этот код данные внутри скобок? Выбор ячейки A1?

Так точно :D
если листов немного - тогда можно прописать условия для каждого, если много - самую правую и самую нижнюю ячейки.
Т.е. для
G8 и на другом листе F8.

[vba]
Код
.Cells(8, "f").Select
[/vba]
Можно как-то в эту строчку добавить Sheet1 и Sheet2, если у меня разные ячейки

[vba]
Код
        .Unprotect "password"
        If .Name = "Sheet1" Then .Cells(8, "g").Select Else .Cells(8, "f").Select
[/vba]

Автор - SLAVICK
Дата добавления - 05.04.2016 в 14:37
KIMVSR Дата: Вторник, 05.04.2016, 15:18 | Сообщение № 9
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 118
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016

[vba]
Код
If .Name = "Sheet1" Then .Cells(8, "g").Select Else .Cells(8, "f").Select
[/vba]

Не совсем так. У меня на Sheet1 ячейка G8, а на Sheet2 - F8.
Тогда так?

[vba]
Код
If .Name = "Sheet1" Then .Cells(8, "G").Select
[/vba]
[vba]
Код
If .Name = "Sheet2" Then .Cells(8, "F").Select
[/vba]
Т.е. как бы две сразу строчки подряд в код на закрытие прописать? Или чушь спорол?
[moder]Код нужно оформлять кнопкой #. Исправил за Вас.[/moder]


Сообщение отредактировал SLAVICK - Вторник, 05.04.2016, 15:36
 
Ответить
Сообщение

[vba]
Код
If .Name = "Sheet1" Then .Cells(8, "g").Select Else .Cells(8, "f").Select
[/vba]

Не совсем так. У меня на Sheet1 ячейка G8, а на Sheet2 - F8.
Тогда так?

[vba]
Код
If .Name = "Sheet1" Then .Cells(8, "G").Select
[/vba]
[vba]
Код
If .Name = "Sheet2" Then .Cells(8, "F").Select
[/vba]
Т.е. как бы две сразу строчки подряд в код на закрытие прописать? Или чушь спорол?
[moder]Код нужно оформлять кнопкой #. Исправил за Вас.[/moder]

Автор - KIMVSR
Дата добавления - 05.04.2016 в 15:18
SLAVICK Дата: Вторник, 05.04.2016, 15:39 | Сообщение № 10
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
Не совсем так. У меня на Sheet1 ячейка G8, а на Sheet2 - F8.

И какая разница в результате - пробовали?
Что в лоб, что по лбу - результат тот же :D
Просто я написал:
[vba]
Код
Если имя листа "Sheet1" - тогда  .Cells(8, "G") иначе .Cells(8, "F")
[/vba]
а Вы сделали вместо одной проверки - две. Так тоже можно. yes


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
Не совсем так. У меня на Sheet1 ячейка G8, а на Sheet2 - F8.

И какая разница в результате - пробовали?
Что в лоб, что по лбу - результат тот же :D
Просто я написал:
[vba]
Код
Если имя листа "Sheet1" - тогда  .Cells(8, "G") иначе .Cells(8, "F")
[/vba]
а Вы сделали вместо одной проверки - две. Так тоже можно. yes

Автор - SLAVICK
Дата добавления - 05.04.2016 в 15:39
KIMVSR Дата: Вторник, 05.04.2016, 15:51 | Сообщение № 11
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 118
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Работает, но не совсем так, как надо. Постараюсь объяснить:
У меня два листа (Sheet1 и Sheet2). На обоих листах есть таблицы.
Предположим, я сдвигаю скролл-бар на Sheet1 и затем перехожу на Sheet2 - там тоже сдвигаю скролл-бар.
Затем я закрываю файл, находясь на листе Sheet2.
Скрипт для Sheet2 срабатывает отлично: скролл-бар возвращается в указанную ячейку, скажем так.
Но вот сдвинутый скролл-бар на Sheet1 так и остаётся в сдвинутом положении после закрытия.

Короче говоря, код срабатывает только на том листе, на котором я нахожусь во время закрытия файла.
А я бы хотел, чтобы при закрытии скролл-бары обоих листов возвращались в исходную позицию.
Такое возможно?


Сообщение отредактировал KIMVSR - Вторник, 05.04.2016, 15:52
 
Ответить
СообщениеРаботает, но не совсем так, как надо. Постараюсь объяснить:
У меня два листа (Sheet1 и Sheet2). На обоих листах есть таблицы.
Предположим, я сдвигаю скролл-бар на Sheet1 и затем перехожу на Sheet2 - там тоже сдвигаю скролл-бар.
Затем я закрываю файл, находясь на листе Sheet2.
Скрипт для Sheet2 срабатывает отлично: скролл-бар возвращается в указанную ячейку, скажем так.
Но вот сдвинутый скролл-бар на Sheet1 так и остаётся в сдвинутом положении после закрытия.

Короче говоря, код срабатывает только на том листе, на котором я нахожусь во время закрытия файла.
А я бы хотел, чтобы при закрытии скролл-бары обоих листов возвращались в исходную позицию.
Такое возможно?

Автор - KIMVSR
Дата добавления - 05.04.2016 в 15:51
_Boroda_ Дата: Вторник, 05.04.2016, 15:54 | Сообщение № 12
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Вам не нужны Ифы, Вам нужно безо всяких условий тупо перебрать все листы
[vba]
Код
Sheets("Sheet1").Cells(8, "G").Select
Sheets("Sheet2").Cells(8, "F").Select
[/vba]

Добавлено.
Все верно ниже написано. Так не прокатит. Поторопился.


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеВам не нужны Ифы, Вам нужно безо всяких условий тупо перебрать все листы
[vba]
Код
Sheets("Sheet1").Cells(8, "G").Select
Sheets("Sheet2").Cells(8, "F").Select
[/vba]

Добавлено.
Все верно ниже написано. Так не прокатит. Поторопился.

Автор - _Boroda_
Дата добавления - 05.04.2016 в 15:54
SLAVICK Дата: Вторник, 05.04.2016, 16:00 | Сообщение № 13
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
А - понял.
В код добавить активацию листа:
[vba]
Код
With sh
       .Activate
       .Unprotect "password"
        If .Name = "Sheet1" Then .Cells(8, "g").Select Else .Cells(8, "f").Select
[/vba]


Иногда все проще чем кажется с первого взгляда.
 
Ответить
СообщениеА - понял.
В код добавить активацию листа:
[vba]
Код
With sh
       .Activate
       .Unprotect "password"
        If .Name = "Sheet1" Then .Cells(8, "g").Select Else .Cells(8, "f").Select
[/vba]

Автор - SLAVICK
Дата добавления - 05.04.2016 в 16:00
KIMVSR Дата: Вторник, 05.04.2016, 16:07 | Сообщение № 14
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 118
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Саш, твой вариант не работал, к сожалению. Т.е. всё было точно также, как и с ифом (срабатывал только на активном листе).
SLAVICK, работает так, как надо! Здорово!

Ребят, большущие вам спасибо! pray
 
Ответить
СообщениеСаш, твой вариант не работал, к сожалению. Т.е. всё было точно также, как и с ифом (срабатывал только на активном листе).
SLAVICK, работает так, как надо! Здорово!

Ребят, большущие вам спасибо! pray

Автор - KIMVSR
Дата добавления - 05.04.2016 в 16:07
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Автоматическое снятие фильтра после закрытия файла (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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