|
Компьютерный форум OSzone.net » Сфера Microsoft » Microsoft Office (Word, Excel, Outlook и т.д.) » 2010 - Скрыть работу скрипта |
|
2010 - Скрыть работу скрипта
|
Старожил Сообщения: 329 |
Профиль | Отправить PM | Цитировать Всем привет, помогите скрыть работу скрипта, а то при добавлении листа прыгает и стандартными средствами не скрывает.
не предлагать - не работают. А так же если есть возможность, то помочь оптимизировать код. Сам код: 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 |
|
Отправлено: 22:32, 25-04-2016 |
Старожил Сообщения: 329
|
Профиль | Отправить PM | Цитировать a_axe, а теперь поясните что тут делает код?
|
Отправлено: 15:16, 27-04-2016 | #11 |
Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети. Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля. |
Динохромный Сообщения: 698
|
Профиль | Отправить PM | Цитировать Как-то так:
Dim DefaultActiveSheet As Worksheet - определяем переменную, в которую позже сохраним тот лист, который является активным при работе программы. Set DefaultActiveSheet = ActiveWorkbook.ActiveSheet - сохраняем лист, который является активным на данный момент в переменную, чтобы сделать его активным при необходимости. ActiveWorkbook.Sheets.Add - добавляем в рабочую книгу еще один лист. Он действительно становится активным. DefaultActiveSheet.Activate - обращаемся к сохраненному листу, который был активным изначально, и перестал быть активным после добавления листа в книгу. Делаем его активным снова. Set DefaultActiveSheet = Nothing - выгружаем значение переменной из памяти, т.к. оно больше не нужно. |
Последний раз редактировалось okshef, 27-04-2016 в 20:36. Отправлено: 15:32, 27-04-2016 | #12 |
Старожил Сообщения: 329
|
Профиль | Отправить PM | Цитировать А создать сразу неактивный никак? Просто все равно если нет скринапдатера то все это видно будет. Или я ошибаюсь?
|
Последний раз редактировалось okshef, 27-04-2016 в 20:36. Отправлено: 17:08, 27-04-2016 | #13 |
Динохромный Сообщения: 698
|
Профиль | Отправить PM | Цитировать Цитата blackeangel:
Цитата blackeangel:
|
||
Отправлено: 17:45, 27-04-2016 | #14 |
Старожил Сообщения: 329
|
Профиль | Отправить PM | Цитировать Цитата a_axe:
|
|||
Отправлено: 20:20, 27-04-2016 | #15 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать Цитата blackeangel:
|
|
Отправлено: 20:38, 27-04-2016 | #16 |
Старожил Сообщения: 329
|
Профиль | Отправить PM | Цитировать Цитата Iska:
|
||
Отправлено: 21:06, 27-04-2016 | #17 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать Например, так:
Скрытый текст
Option Explicit Sub MainSub() Application.ScreenUpdating = False Call SomeSub(bScreenUpdate:=False) If Application.ScreenUpdating = False Then Application.ScreenUpdating = True End If End Sub Sub OtherSub() Call SomeSub End Sub Sub SomeSub(Optional bScreenUpdate As Boolean = True) Debug.Print bScreenUpdate, Application.ScreenUpdating If bScreenUpdate Then Application.ScreenUpdating = False End If Debug.Print bScreenUpdate, Application.ScreenUpdating ' Some code here… If bScreenUpdate And Application.ScreenUpdating = False Then Application.ScreenUpdating = True End If Debug.Print bScreenUpdate, Application.ScreenUpdating End Sub Принцип понятен? |
Последний раз редактировалось Iska, 28-04-2016 в 00:23. Причина: Откорректировал код. Отправлено: 00:00, 28-04-2016 | #18 |
Участник сейчас на форуме | Участник вне форума | Автор темы | Сообщение прикреплено |
| |||||
Название темы | Автор | Информация о форуме | Ответов | Последнее сообщение | |
[решено] Windows XP - определить работу скрипта в безопасном режиме | -TRM- | AutoIt | 2 | 22-04-2014 16:34 | |
CMD/BAT - Как скрыть работу скрипта? | rek90 | Скриптовые языки администрирования Windows | 5 | 13-10-2013 13:34 | |
Info - Как скрыть работу в браузере Mozilla FireFox, зашифровав папку профиля? | rygBuH | Защита компьютерных систем | 0 | 19-07-2012 12:45 | |
Как скрыть от программы работу под терминальным клиентом | ffirefox | Microsoft Windows NT/2000/2003 | 3 | 20-05-2010 01:38 | |
Есть возможность устроиться на работу по сборке компов.Потяну ли эту работу ? | teapot08 | Флейм | 27 | 17-01-2010 14:15 |
|