Новости
Видео
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

 

Ветеран


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

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

Цитата blackeangel:
не предлагать - не работают. »
В чём именно заключается «не работа»? В том, что Вы не к месту применяете «Application.ScreenUpdating = True»?!

Отправлено: 01:26, 26-04-2016 | #2



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

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


Аватара для blackeangel

Старожил


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

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

Цитата Iska:
Цитата blackeangel:
не предлагать - не работают. »
В чём именно заключается «не работа»? В том, что Вы не к месту применяете «Application.ScreenUpdating = True»?!
Так скажите как будет к месту?
Если оставить только в All in one () то результат тот же, прыгают и скачут листы.

Последний раз редактировалось blackeangel, 26-04-2016 в 08:48.

Отправлено: 07:09, 26-04-2016 | #3


Ветеран


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

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

Покажите документ. Опишите работу.

Отправлено: 17:55, 26-04-2016 | #4


Аватара для blackeangel

Старожил


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

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

Цитата Iska:
Покажите документ. Опишите работу.
Исходный Лист Sheet, все последующие создает макрос.
Что надо сделать, точнее что уже сделал я:
1. Создать дубль листа под названием "Рабочий" (и на каждом листе должны быть сквозные строки, отформатировано по ширине и высоте по содержимому, стоять автофильтр)
2. Удалить дубликаты по "Обозначение" и отрезать все до "Маршрут" справа(начиная с столбца E и все что правее)
3. На отдельный лист вынести Столбец "Сборки" и удалить дубликаты, назвать "Сборки для диспетчера", переименовать заголовок с "Сборка" на "№ сборки"
4. На отдельный лист вынести что имеет в столбце "цех" ЭМЦ и назвать "ЭМЦ"
5. На отдельный лист вынести что имеет в столбце "цех" СМЦ и МЦ и назвать "МЦ+СМЦ"
6. На отдельный лист вынести все что не содержит пусто по столбцам "Карточки" и "ПредвАрхив" и назвать "Без КД"
7. Отправить по почте лист "Нет КД", не вложением, а заполнив тело сообщения содержимым листа "Нет КД", с переменным отправителем, название темы сообщения берется с названия листа(этот пункт в планах еще, тк не знаю как заполнить тело письма)

Последний раз редактировалось blackeangel, 03-04-2017 в 22:53.

Отправлено: 19:04, 26-04-2016 | #5


Ветеран


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

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

blackeangel, я не придираюсь. Но я предполагаю, что я увижу в выложенном а) Рабочую книгу с б) макросами, с указанием: запускаем макрос XYZ() — наблюдаем описанную:
Цитата blackeangel:
Если оставить только в All in one () то результат тот же, прыгают и скачут листы. »
проблему. При этом код, как минимум, не будет содержать ошибок времени исполнения.

Отправлено: 22:45, 26-04-2016 | #6


Ветеран


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

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

Я взял Ваш код из сообщения #1 и поместил его в Вашу Рабочую книгу из сообщения #5. Удалил из оной Рабочей книги все листы, кроме «Sheet». Закомментировал:
  • все упоминания «Application.ScreenUpdating», кроме как в начале (=False) и в конце (=True) процедуры «All_in_one()»;
  • все отсутствующие и потому не работающие в моей версии Office объекты/методы/свойства;
  • все прочие оставшиеся ошибки времени исполнения, не вызванные отсутствующими объектами/методами/свойствами.
Вызвал из Рабочей книги исполнение процедуры «All_in_one()». Никаких прыжков/скачков листов во время исполнения кода не увидел.

Отправлено: 23:37, 26-04-2016 | #7


Аватара для blackeangel

Старожил


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

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

Цитата Iska:
Я взял Ваш код из сообщения #1 и поместил его в Вашу Рабочую книгу из сообщения #5. Удалил из оной Рабочей книги все листы, кроме «Sheet». Закомментировал:
  • все упоминания «Application.ScreenUpdating», кроме как в начале (=False) и в конце (=True) процедуры «All_in_one()»;
  • все отсутствующие и потому не работающие в моей версии Office объекты/методы/свойства;
  • все прочие оставшиеся ошибки времени исполнения, не вызванные отсутствующими объектами/методами/свойствами.
Вызвал из Рабочей книги исполнение процедуры «All_in_one()». Никаких прыжков/скачков листов во время исполнения кода не увидел.
Хорошо. Можно этот код как то переписать избегая перехода на листы?
Просто некоторые Sub используются отдельно в надстройке как самостоятельные и из них выкинуть Application.ScreenUpdating никак.

Последний раз редактировалось blackeangel, 27-04-2016 в 09:49.

Отправлено: 09:42, 27-04-2016 | #8


Аватара для blackeangel

Старожил


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

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

при создании листа или его дубликата он по умолчанию активен. Вот как это побороть?

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


Динохромный


Contributor


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

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

Цитата blackeangel:
при создании листа или его дубликата он по умолчанию активен. Вот как это побороть? »
например так:
Код: Выделить весь код
    Dim DefaultActiveSheet As Worksheet
    Set DefaultActiveSheet = ActiveWorkbook.ActiveSheet
    ActiveWorkbook.Sheets.Add
    DefaultActiveSheet.Activate
    Set DefaultActiveSheet = Nothing

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

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


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


 
Переход