Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.57/7: Рейтинг темы: голосов - 7, средняя оценка - 4.57
7 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 677
1

Скрыть работу скрипта

25.04.2016, 22:30. Показов 1363. Ответов 15
Метки нет (Все метки)

Всем привет, помогите скрыть работу скрипта, а то при добавлении листа прыгает и стандартными средствами не скрывает.
Visual Basic
1
2
Application.ScreenUpdating = False
Application.ScreenUpdating = true
не предлагать - не работают.
А так же если есть возможность, то помочь оптимизировать код. Сам код:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
Sub All_in_one()
Application.ScreenUpdating = False
'On Error Resume Next
viravnivanie 'выравниваем по содержимому
'готовим сборки для заноса в диспетчер
Cells.Find(What:="Сборка", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns).Activate
ncolumn2 = ActiveCell.Column
Columns(ncolumn2).Copy
    Sheets.Add After:=Sheets(ActiveSheet.Index)
    ActiveSheet.Name = "Сборки для диспетчера"
    ActiveSheet.Paste
ActiveSheet.UsedRange.RemoveDuplicates Columns:=ncolumn2, Header:=xlYes 'удаляем дубли по найденой выше колонке
'заменяем для удобности ВО ВСЕЙ КНИГЕ!
'For Each sh In Sheets
'    sh.Cells.Replace "Сборка", "№ сборки"
'Next
'заменяем  для удобности НА ТЕКУЩЕМ ЛИСТЕ!
Cells.Replace What:="Сборка", Replacement:="№ сборки", LookAt:=xlWhole, _
    SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
   ReplaceFormat:=False
viravnivanie 'выравниваем по содержимому
 
'Sheets.Add After:=Sheets(Sheets.Count) 'вставляем новый лист после текущего
 
Worksheets(1).Copy After:=Sheets(Worksheets(1).Index) 'вставляем дубликат активного листа после текущего
ActiveSheet.Name = "Рабочий" 'задаем имя
Columns("E:R").Delete 'Удаляем лишнее
'ищем колонку по обозначению
Cells.Find(What:="Обозначение", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns).Activate
ncolumn = ActiveCell.Column
ActiveSheet.UsedRange.RemoveDuplicates Columns:=ncolumn, Header:=xlYes 'удаляем дубли по найденой выше колонке
 
ActiveSheet.UsedRange.AutoFilter 'ставим автофильтр
viravnivanie 'выравниваем по содержимому
Cexnalist 'цеха на лист ()
 
Sheets("Рабочий").Activate
 
Application.ScreenUpdating = True
End Sub
Sub Cexnalist()
Application.ScreenUpdating = False 'тормозим отображение на экране
'On Error Resume Next
NetKD 'нет КД
Sheets("Рабочий").Activate
ActiveSheet.ShowAllData 'сбрасываем автофильтр
'фильтруем по МЦ+СМЦ
Sheets("Рабочий").UsedRange.AutoFilter Field:=7, Criteria1:="=МЦ", _
        Operator:=xlOr, Criteria2:="=СМЦ"
Sheets("Рабочий").UsedRange.Copy 'копируем отфильтрованное
Range("A1").Select 'сбрасываем выделение
Sheets.Add After:=Sheets(Sheets("Рабочий").Index + 2) 'Вставляем лист через 1
    ActiveSheet.Name = "МЦ+СМЦ" 'задаем имя нового листа
ActiveSheet.Paste 'вставляем скопированное
ActiveSheet.UsedRange.AutoFilter 'ставим автофильтр
viravnivanie 'выравниваем по содержимому
 
Sheets("Рабочий").Activate
Sheets("Рабочий").UsedRange.AutoFilter Field:=7, Criteria1:="ЭМЦ"
Sheets("Рабочий").UsedRange.Copy 'копируем отфильтрованное
    Range("A1").Select
    Sheets.Add After:=Sheets(Sheets("Рабочий").Index + 3)
    ActiveSheet.Name = "ЭМЦ"
ActiveSheet.Paste
ActiveSheet.UsedRange.AutoFilter 'ставим автофильтр
viravnivanie 'выравниваем по содержимому
 
Sheets("Рабочий").ShowAllData 'сбрасываем автофильтр
 
askDialog 'Печатаем всё
 
Application.ScreenUpdating = True
End Sub
Sub NetKD() 'нет КД
Application.ScreenUpdating = False
'On Error Resume Next
Sheets("Рабочий").Activate
'отфильтровываем только пустые
    ActiveSheet.UsedRange.AutoFilter Field:=3, Criteria1:="="
    ActiveSheet.UsedRange.AutoFilter Field:=4, Criteria1:="="
ActiveSheet.UsedRange.Copy 'копируем отфильтрованное
    Range("A1").Select
    Sheets.Add After:=Sheets(Sheets("Рабочий").Index + 1)
    ActiveSheet.Name = "Без КД"
ActiveSheet.Paste
Columns("C:R").Delete 'Удаляем лишнее
viravnivanie 'выравниваем по содержимому
Application.ScreenUpdating = True
End Sub
 
 
Sub viravnivanie() 'выравниваем по содержимому
Application.ScreenUpdating = False
ActiveSheet.UsedRange.Select
With Selection
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = True
        .ReadingOrder = xlContext
        .MergeCells = False
End With
Selection.Columns.AutoFit
'крепим верхнюю строку
ActiveSheet.Rows(2).Select
ActiveWindow.FreezePanes = True
Range("A1").Select
'сквозные строки
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
Application.ScreenUpdating = True
End Sub
Sub askDialog() 'запрос на печать
ask = MsgBox("Распечатать?", vbYesNo, "Печать")
If ask = 6 Then
Sheets("ЭМЦ").Copy After:=Sheets(Sheets("ЭМЦ").Index) 'вставляем дубликат активного листа после текущего
Columns(3).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 'Пустые строки для МСК
'отфильтровываем только пустые
    ActiveSheet.UsedRange.AutoFilter Field:=4, Criteria1:="="
    ActiveSheet.UsedRange.AutoFilter Field:=5, Criteria1:="="
Range("2:" & Rows.Count).Delete 'удаляем все, кроме 2 строки
ActiveSheet.ShowAllData 'сбрасываем автофильтр
'Сортируем по сборке
    ActiveSheet.AutoFilter.Sort.SortFields.Clear
    ActiveSheet.AutoFilter.Sort.SortFields.Add Key:=Range( _
        "A1:A50000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveSheet.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
viravnivanie 'выравниваем по содержимому
'удаляем без вопросов
Application.DisplayAlerts = False
Sheets(Sheets("ЭМЦ").Index + 1).Delete
Application.DisplayAlerts = True
 
Sheets("МЦ+СМЦ").Copy After:=Sheets(Sheets("МЦ+СМЦ").Index) 'вставляем дубликат активного листа после текущего
'отфильтровываем только пустые
    ActiveSheet.UsedRange.AutoFilter Field:=3, Criteria1:="="
    ActiveSheet.UsedRange.AutoFilter Field:=4, Criteria1:="="
Range("2:" & Rows.Count).Delete 'удаляем все, кроме 2 строки
ActiveSheet.ShowAllData 'сбрасываем автофильтр
'Сортируем по сборке
    ActiveSheet.AutoFilter.Sort.SortFields.Clear
    ActiveSheet.AutoFilter.Sort.SortFields.Add Key:=Range( _
        "A1:A50000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveSheet.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
viravnivanie 'выравниваем по содержимому
'удаляем без вопросов
Application.DisplayAlerts = False
Sheets(Sheets("МЦ+СМЦ").Index + 1).Delete
Application.DisplayAlerts = True
Else
    Exit Sub
End If
End Sub
0

Помощь в написании контрольных, курсовых и дипломных работ здесь.

Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
25.04.2016, 22:30
Ответы с готовыми решениями:

Выйти из цикла завершить работу скрипта
Здравствуйте, Скрипт отрабатывает и не выходит из цикла Скрипт запускает 2 программы и...

Как можно связать работу скрипта из балуна с работой скрипта на странице?
Первый раз задаю вопрос, извините если не в тот раздел. В общем, делаю метку через Яндекс карты...

Доработка скрипта показать\скрыть
Здравствуйте! Для показа\скрытия блока по клику использую такой скрипт: <a id="open-close"...

Скрыть консоль во время выполнения скрипта
Здравствуйте! Подскажите пожалуйста: Есть скрипт на perl (Active Perl 5.20) он висит в...

15
Заблокирован
26.04.2016, 08:02 2
Цитата Сообщение от blackeangel Посмотреть сообщение
ScreenUpdating ... не предлагать - не работают.
Не спешите с подобными заявлениями!
Оставьте ScreenUpdating только в одной (Sub All_in_one) процедуре, в остальных удалите (вы включаете ScreenUpdating после каждого viravnivanie и т.д. - потому и не работают, видимо).
0
7 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 677
26.04.2016, 08:14  [ТС] 3
Цитата Сообщение от Shersh Посмотреть сообщение
Не спешите с подобными заявлениями!
Оставьте ScreenUpdating только в одной (Sub All_in_one) процедуре, в остальных удалите (вы включаете ScreenUpdating после каждого viravnivanie и т.д. - потому и не работают, видимо).
Пробовал оставить только в ней - не помогло. Так же прыгают и мелькают листы
0
409 / 259 / 80
Регистрация: 27.10.2012
Сообщений: 853
26.04.2016, 08:45 4
Цитата Сообщение от blackeangel Посмотреть сообщение
помочь оптимизировать код
Файл пример с объяснениями что делать надо.
0
7 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 677
26.04.2016, 09:18  [ТС] 5
Цитата Сообщение от kalbasiatka Посмотреть сообщение
Файл пример с объяснениями что делать надо.
Исходный Лист Sheet, все последующие создает макрос.
Что надо сделать, точнее что уже сделал я:
1. Создать дубль листа под названием "Рабочий" (и на каждом листе должны быть сквозные строки, отформатировано по ширине и высоте по содержимому, стоять автофильтр)
2. Удалить дубликаты по "Обозначение" и отрезать все до "Маршрут" справа(начиная с столбца E и все что правее)
3. На отдельный лист вынести Столбец "Сборки" и удалить дубликаты, назвать "Сборки для диспетчера", переименовать заголовок с "Сборка" на "№ сборки"
4. На отдельный лист вынести что имеет в столбце "цех" ЭМЦ и назвать "ЭМЦ"
5. На отдельный лист вынести что имеет в столбце "цех" СМЦ и МЦ и назвать "МЦ+СМЦ"
6. На отдельный лист вынести все что не содержит пусто по столбцам "Карточки" и "ПредвАрхив" и назвать "Без КД"
7. Отправить по почте лист "Нет КД", не вложением, а заполнив тело сообщения содержимым листа "Нет КД", с переменным отправителем, название темы сообщения берется с названия листа
0
Вложения
Тип файла: xlsx Пример.xlsx (32.0 Кб, 7 просмотров)
Заблокирован
26.04.2016, 10:03 6
Цитата Сообщение от blackeangel Посмотреть сообщение
Пробовал оставить только в ней - не помогло.
А у меня помогло сразу же (выводы делайте сами)
0
7 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 677
27.04.2016, 09:50  [ТС] 7
Цитата Сообщение от Shersh Посмотреть сообщение
А у меня помогло сразу же (выводы делайте сами)
Ну если что у меня WinXP и офис 2010
Может проблема в этом. Но еще один момент есть, там вызываются несколько часов и они содержат эти строки. Может проблема в них? Если да, то как их обойти, тк эти Сабы из надстроки и из них нельзя выкинуть эти строки.

Добавлено через 23 часа 20 минут
Хорошо. Можно этот код как то переписать избегая перехода на листы?
Просто некоторые Sub используются отдельно в надстройке как самостоятельные и из них выкинуть Application.ScreenUpdating никак.
0
3443 / 2108 / 698
Регистрация: 02.11.2012
Сообщений: 5,505
27.04.2016, 09:58 8
Цитата Сообщение от blackeangel Посмотреть сообщение
избегая перехода на листы?
Visual Basic
1
2
3
4
With Sheets("рабочий") 'работаем с листом "рабочий"
.Cells(1,1) 'так как перед Cells стоит точка то обращение идет к ячейке листа указанного после With
Cells(1,1) 'так как перед Cells не стоит точка то обращение идет к ячейке активного листа
end with
0
7 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 677
27.04.2016, 10:08  [ТС] 9
Vlad999, это все хорошо, но при создании листа или его дубликата он по умолчанию активен. Вот как это побороть?
0
11 / 11 / 7
Регистрация: 19.04.2016
Сообщений: 92
28.04.2016, 11:35 10
Никак, только переходом на предыдущий активный лист.
0
6839 / 2779 / 523
Регистрация: 19.10.2012
Сообщений: 8,466
28.04.2016, 11:44 11
Цитата Сообщение от blackeangel Посмотреть сообщение
при создании листа или его дубликата он по умолчанию активен. Вот как это побороть?
- незачем это бороть, да и невозможно. Да и переходить по листам никакого смысла обычно нет - просто указывайте в коде с каким листом конкретно работаете, Влад показал как.
0
7 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 677
28.04.2016, 16:29  [ТС] 12
Hugo121, все это прекрасно, но нельзя остаться на первоначальном листе создав новый. Он по умолчанию активен. И для того чтобы вернуться на предыдущей надо скакать по листам. И так с каждым новым.
0
6839 / 2779 / 523
Регистрация: 19.10.2012
Сообщений: 8,466
28.04.2016, 16:56 13
Ну скакать по новым придётся - но ведь Вы отлючили обновление экрана, это не должно быть видно. А в чём смысл возвращаться на предыдущий? Ну разве что есть смысл один раз в конце кода активировать исходный лист.
0
7 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 677
28.04.2016, 23:33  [ТС] 14
Hugo121, а сразу скрытый создать лист можно? И будет ли он печататься?
0
6839 / 2779 / 523
Регистрация: 19.10.2012
Сообщений: 8,466
28.04.2016, 23:34 15
Цитата Сообщение от blackeangel Посмотреть сообщение
сразу скрытый создать лист можно
- нельзя. Но можно создать и скрыть.
Печататься кажется не будет (проверьте) - но можно показать, напечатать, скрыть.
0
7 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 677
01.05.2016, 17:12  [ТС] 16
Vlad999, так будет работать
Visual Basic
1
with Sheets(ActiveSheet.Index+1)
А то у меня не работает.
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
01.05.2016, 17:12

Помощь в написании контрольных, курсовых и дипломных работ здесь.

Скрыть текст после выполнения скрипта
Добрый день, у меня возникла проблема, есть скрипт отправки почты и записи результата в БД: <?php ...

Как скрыть файлы скрипта в файлменеджере?
Веб-файлменеджер отображает файлы самого себя. Как это исправить? Название скрипта: PHPFM.

CppWebBrowser скрыть работу
Доброго дня.Подскажите как скрыть работу CppWebBrowser (нужно сделать его полностью не видимым)...

Как скрыть имя скрипта при запросе из формы поиска?
Как скрыть имя скрипта при запросе из формы поиска? Задача такая: есть страничка html: <Form...

ускорить работу скрипта
Друзья - php скрипт выполняется более 400 секунд! Подскажите что можно подправить - что бы...

Отследить работу скрипта
Доброго времени суток уважаемые форумчане. Признаюсь сразу, о скриптах знаю поверхностно. Попытаюсь...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
16
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.