Новости
Видео
Microsoft
Windows 10
Железо
Программы
Форум

Имя пользователя:
Пароль:
 | Правила  

Компьютерный форум OSzone.net » Сфера Microsoft » Microsoft Office (Word, Excel, Outlook и т.д.) » 2010 - Скрыть работу скрипта

< Предыдущая 1 2
Ответить
Настройки темы
2010 - Скрыть работу скрипта

Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать

Всем привет, помогите скрыть работу скрипта, а то при добавлении листа прыгает и стандартными средствами не скрывает.
Код: Выделить весь код
Application.ScreenUpdating = False
Application.ScreenUpdating = true
не предлагать - не работают.
А так же если есть возможность, то помочь оптимизировать код. Сам код:
Код: Выделить весь код
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

 

Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать

a_axe, а теперь поясните что тут делает код?

Отправлено: 15:16, 27-04-2016 | #11



Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети.

Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля.


Динохромный


Contributor


Сообщения: 712
Благодарности: 322

Профиль | Отправить 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


Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать

А создать сразу неактивный никак? Просто все равно если нет скринапдатера то все это видно будет. Или я ошибаюсь?

Последний раз редактировалось okshef, 27-04-2016 в 20:36.

Отправлено: 17:08, 27-04-2016 | #13


Динохромный


Contributor


Сообщения: 712
Благодарности: 322

Профиль | Отправить PM | Цитировать

Цитата blackeangel:
А создать сразу неактивный никак? »
Поиск ничего не дал, мне способ не известен.
Цитата blackeangel:
Просто все равно если нет скринапдатера то все это видно будет. »
Попробуйте с вашим файлом - у меня мигает рабочий лист на долю секунды. Насколько это критично, вам виднее, мне кажется пользователь даже понять ничего не успеет.

Отправлено: 17:45, 27-04-2016 | #14


Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать

Цитата a_axe:
Цитата blackeangel:
А создать сразу неактивный никак? »
Поиск ничего не дал, мне способ не известен.
Цитата blackeangel:
Просто все равно если нет скринапдатера то все это видно будет. »
Попробуйте с вашим файлом - у меня мигает рабочий лист на долю секунды. Насколько это критично, вам виднее, мне кажется пользователь даже понять ничего не успеет.
Искать то искал сам, тоже ничего не нашел. А если создать сразу скрытый лист?и как это сделать?

Отправлено: 20:20, 27-04-2016 | #15


Ветеран


Сообщения: 27449
Благодарности: 8088

Профиль | Отправить PM | Цитировать

Цитата blackeangel:
Просто некоторые Sub используются отдельно в надстройке как самостоятельные и из них выкинуть Application.ScreenUpdating никак. »
А придётся с этим что-то делать. Можете, например, при вызове передавать в такие процедуры параметр, определяющий потребность исполнять в ней в данном вызове «Application.ScreenUpdating». Но смотрите сами, я весь Ваш код не вижу, не могу сказать, как будет лучше.

Отправлено: 20:38, 27-04-2016 | #16


Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать

Цитата Iska:
Цитата blackeangel:
Просто некоторые Sub используются отдельно в надстройке как самостоятельные и из них выкинуть Application.ScreenUpdating никак. »
А придётся с этим что-то делать. Можете, например, при вызове передавать в такие процедуры параметр, определяющий потребность исполнять в ней в данном вызове «Application.ScreenUpdating».
Это как?

Отправлено: 21:06, 27-04-2016 | #17


Ветеран


Сообщения: 27449
Благодарности: 8088

Профиль | Отправить 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

< Предыдущая 1 2


Компьютерный форум OSzone.net » Сфера Microsoft » Microsoft Office (Word, Excel, Outlook и т.д.) » 2010 - Скрыть работу скрипта

Участник сейчас на форуме Участник сейчас на форуме Участник вне форума Участник вне форума Автор темы Автор темы Шапка темы Сообщение прикреплено

Похожие темы
Название темы Автор Информация о форуме Ответов Последнее сообщение
[решено] 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


« Предыдущая тема | Следующая тема »


 
Переход