Сделала все как было посоветовано выше. Файл стал весить значительно меньше на 66%. Но проблема с зависанием курсора в строке осталась((( Проверила принтеры. Антивирусник софос. Зависает на любом компьютере. Помогите, пожалуйста
Кстати, вот что еще заметила. Первый ввод-зависает, второй третий и т.д. все ок пока (!) не сделаешь паузу. Если проходит больше нескольких секунд снова зависание на первой редактируемой ячейке.
Получилось примерно так... https://dropmefiles.com/qFqXr Дополняю: при любом вводе в ячейку файл зависает, т.е. курсор там и стоит и только спустя какое-то время начинает пересчет. И кстати, старый файл весил около 16МБ и работал. Этот около 6МБ...не работает(((
китин, спасибо за совет! Боюсь мне это не поможет... Файл до моей очистки весил гораздо больше, а работал исправно. Быстрее чем сейчас. Вот и удивляюсь чудесам) whitemanehorsey, спасибо, попробуем...) TheBestOfTheBest, я попробую завтра удалить всю информацию заводскую и оставить только формулы да макросы. Но уже только это займет много времени))) Если будут идеи до этого буду очень благодарна!=)
Есть файл, который заполняется ежедневно. Каждый день создаются два новых листа с соответствующими датами и в них работают наши операторы. Не так давно я его почистила (как обычно), т.е. удалила старые даты-листы. Но примерно с того же момента файл стал жутко тормозить. Вбиваем любые данные в любую из ячеек, как он зависает, потом еще пересчитывает (правда это в лучшем случае, обычно завис и пока комп не перезагрузить ничего дальше не сделать). В целом это ооочень усложняет работу. Ведь ждать каждую ячейку по мин 10-15, а их около 100 это не дело. Проверила все. Формулы как в старой версии, макросы тоже. Никак не пойму что с файликом. Выложить не могу, к сожалению, может кто сталкивался с похожей проблемой? Есть ли методы ее решения?
Нажимаю далее enter, так? У меня все то же сообщение об ошибке... Не могу проверить путь((( Я правильно все делаю, подскажите, пожалуйста?
Все! Поняла. Я очередность макросов неправильно соблюдала. Сначала переименовывала лист, а потом пыталась ссылаться на него. Отсюда и ошибка. Он уже такого листа не видел. Спасибо большое!!!
Последний разочек по этому макросу помогите, пожалуйста. Макрос, который создает папку и называет ее, там создает книгу и называет ее (если такой книги еще нет) еще должен копировать с первой книги активный лист в созданную.
Код
Sub Main()
Const strRootFolder As String = "M:\Production\Masters\2017\Normalization"
Dim strFolder As String
strFolder = "M:\Production\Masters\2017\Normalization\" & Range("folder_name").Value
If Dir(strFolder, vbDirectory) = "" Then
MkDir strFolder
End If
Dim strFileName As String
Dim strFileTitle As String
strFileTitle = "M:\Production\Masters\2017\Normalization\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("folder_name").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("Книга") & ".xlsm"
strFileName = "M:\Production\Masters\2017\Normalization\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("folder_name").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("Книга") & ".xlsm"
If Dir(strFileName) <> "" Then
MsgBox "OK"
Else
Dim New_Wb As Workbook
Set New_Wb = Workbooks.Add
New_Wb.Activate
New_Wb.SaveAs "M:\Production\Masters\2017\Normalization\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("folder_name").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("Книга") & ".xlsm", 52
End If
Windows("Расчет.xlsm").Activate
Dim sh As Worksheet: Set sh = ActiveSheet
Call Sheet_Name
Application.ScreenUpdating = False
With Workbooks.Open("M:\Production\Masters\2017\Normalization\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("folder_name").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("Книга") & ".xlsm")
sh.Copy , .Worksheets(.Worksheets.Count)
.Close True
End With
Windows("Расчет.xlsm").Activate
End Sub
Но на строке
Код
With Workbooks.Open("M:\Production\Masters\2017\Normalization\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("folder_name").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("Книга") & ".xlsm")
Ошибка 9: subscript out of range Почитала в интеренете, ошибка говорит о том, что нет такого пути. Но как его не может быть? Я ведь полностью указала весь путь к книге...
Sub Main()
Const strRootFolder As String = "M:\Production\Masters\2017\Normalization
Dim strFolder As String
strFolder = "M:\Production\Masters\2017\Normalization\" & Range("folder_name").Value
If Dir(strFolder, vbDirectory) = "" Then
MkDir strFolder
End If
Dim strFileName As String
Dim strFileTitle As String
strFileTitle = "M:\Production\Masters\2017\Normalization\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("folder_name").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("Книга") & ".xlsm"
strFileName = "M:\Production\Masters\2017\Normalization\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("folder_name").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("Книга") & ".xlsm"
If Dir(strFileName) <> "" Then
MsgBox "OK"
Else
Dim New_Wb As Workbook
Set New_Wb = Workbooks.Add
New_Wb.Activate
New_Wb.SaveAs "M:\Production\Masters\2017\Normalization\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("folder_name").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1").Range("Книга") & ".xlsm", 52
End If
Windows("Расчет.xlsm").Activate
End Sub
JayBhagavan, Если нажму да, а туда уже успели скопировать лист из первоначальной книги (Расчет), данные потеряются. А мне нужно чтобы они накапливались... Название книги это дата и ФИО, а листы это будут работы сотрудников...
Я все еще мучаюсь с одним макросом первую часть, которого мне помогли написать здесь. Совсем я еще чайник в VBA((( Вот есть код
Код
Sub Main()
Const strRootFolder As String = "M:\Production\Мастера\2017\Нормализация"
Dim strFolder As String
strFolder = "M:\Production\Мастера\2017\Нормализация\" & Range("имя_папки").Value
If Dir(strFolder, vbDirectory) = "" Then
MkDir strFolder
End If
Dim New_Wb As Workbook
Set New_Wb = Workbooks.Add
New_Wb.Activate
New_Wb.SaveAs "M:\Production\Мастера\2017\Нормализация\" & Workbooks("Расчет.xlsm").Worksheets("1 норм").Range("имя_папки").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1 норм").Range("Книга") & ".xlsm", 52
Папка = "M:\Production\Мастера\2017\Нормализация\" & Workbooks("Расчет.xlsm").Worksheets("1 норм").Range("имя_папки").Value & "\"
Имя = Dir(Папка & "*.xls*")
Do While Имя <> ""
If Имя <> "M:\Production\Мастера\2017\Нормализация\" & Workbooks("Расчет.xlsm").Worksheets("1 норм").Range("имя_папки").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1 норм").Range("Книга") & ".xlsm" Then MkDir New_Wb Else Workbooks.Open Filename:="M:\Production\Мастера\2017\Нормализация\" & Workbooks("Расчет.xlsm").Worksheets("1 норм").Range("имя_папки").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1 норм").Range("Книга") & ".xlsm"
Имя = Dir
Loop
Windows("Расчет.xlsm").Activate
End Sub
Суть в том, что по макросу создается папка с определенным названием, а затем в этой папке создается книга, куда потом будут копироваться листы из первоначального файла, тоже с определенным названием. Но эта книга должна создаваться, если такой (с таким названием) еще нет... Но он не работает(( Выдает окошко с вопросом: файл с таким названием уже есть, заменить? Я нажимаю нет, и дальше ошибка на строку New_Wb. Save As
Помогите, пожалуйста
P.S. Такая тема уже есть вот здесь. Я просто думаю, может и здесь какие идеи будут)))
The_Prist, Возможно мы действительно не понимаем друг друга. С этой учетки но уже на другом ноуте все работает... То есть на другом ноуте условия для отображения листов для этого пользователя есть-соблюдаются...
The_Prist, ошибка в конце возникает, но там ошибка 1004 неверный пароль. И разве если бы была ошибка в имени учетки, на других ноутах тоже бы не открывалось. Но везде кроме этого злополучного ноута не работает((
The_Prist, при открытии файла. А кнопка Debug не работает...
Хочу еще добавить: если заходить через этого пользователя на мой ноут (1)-все работает. Через мою учетку на тот ноут (2), где не работало-опять-таки все работает. А через учетку конкретного пользователя на тот самый ноут (2) не работает. Словно это конфликт учетки с ноутом. Знаю звучит странно...
В общем, с попыткой листа Мэйн мало что вышло. Я не особо дружу с макросами, хоть и приходиться с ними работать. Видимо что-то не так делаю... Сейчас попробую проверить на видимость. О результатах отпишусь
А почему такая проблема возникает только у одного пользователя? Раньше у него был другой компьютер и все работало отлично. А после замены (новый купили) все пошло не так...
Этот же пользователь заходит в учетку через мой комп - и все снова работает...
Irbis_evs, Ох, это несколько проблематично. Нужно новый файл создать, оригинал содержит в себе коммерческую тайну Пока выкладываю код, файл позже выложу. Спасибо))) Этот код на листах, которые либо нужно, либо не нужно скрывать.
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
Этот в книге:
Код
Private Sub Workbook_Open()
Dim sh As Worksheet 'назначает переменную для листа
For Each sh In ActiveWorkbook.Worksheets
sh.Unprotect "password"
sh.Visible = True
Next sh
'ищем последнюю занятую строчку в логах
lastrow = Worksheets("Лог").Range("A60000").End(xlUp).Row
'заносим имя пользователя и дату-время входа в файл
Worksheets("Лог").Cells(lastrow + 1, 1) = Environ("USERNAME")
Worksheets("Лог").Cells(lastrow + 1, 2) = Now
'отображаем все листы
Dim a As Range
For Each sh In ActiveWorkbook.Worksheets
Set Rng = sh.Range("d10:bt10") 'строка дат
' ниже в списке указываем администраторов файла, то есть Финансистов
If UCase(Environ("USERNAME")) = UCase("Name.Surname") Or _
UCase(Environ("USERNAME")) = UCase("Name.Surname") Or _
UCase(Environ("USERNAME")) = UCase("1") Then
For Each a In Rng
a.EntireColumn.Hidden = False
Next a
' Ниже указываем вторичных пользователей HR, Director
ElseIf UCase(Environ("USERNAME")) = UCase("3") Or _
UCase(Environ("USERNAME")) = UCase("2") Or _
UCase(Environ("USERNAME")) = UCase("Name.Surname") Or _
UCase(Environ("USERNAME")) = UCase("2") Or _
UCase(Environ("USERNAME")) = UCase("1") Then
For Each a In Rng
a.EntireColumn.Hidden = False
Next a
sh.Cells.Locked = True
ElseIf UCase(Environ("USERNAME")) = UCase("Name.Surname") Or _
UCase(Environ("USERNAME")) = UCase("Name.Surname") Or _
UCase(Environ("USERNAME")) = UCase("Name.Surname") Or _
UCase(Environ("USERNAME")) = UCase("Name.Surname") Then
sh.Range("A17:BM133").Locked = False
sh.Range("D11:BM11").Locked = False
For Each a In Rng
a.EntireColumn.Hidden = False
Next a
Else
sh.Cells.Locked = True
sh.Range("A17:C133").Locked = False 'снимает защиту с ФИО и Должности
sh.Range("A17:A31").Locked = True 'ставим защиту на список людей
sh.Range("D11:BM11").Locked = False 'снимаем защиту со строки выпуска продукции
For Each a In Rng
If a = Date Or a = Date + 1 Or a = Date - 1 Then
a.Rows("8:124").Locked = False 'указать начиная с какой строки после проверяемого диапазона Rng снять защиту с ячеек (первая ячейка ссылается на диапазон)
a.EntireColumn.Hidden = False 'открываем дни: тек день, -1 день, +1день
Else
a.EntireColumn.Hidden = True
End If
Next a
End If
Next sh
If UCase(Environ("USERNAME")) = UCase("Name.Surname") Or _
UCase(Environ("USERNAME")) = UCase("Name.Surname") Then
Else
For Each sh In ActiveWorkbook.Worksheets
sh.Protect Password:="password"
If Worksheets("Parameters").Range("B3") = sh.Name Or Worksheets("Parameters").Range("B4") = sh.Name Then
Else
sh.Visible = xlSheetVeryHidden
End If
Next sh
'скрываем листы ПРЕДУПРЕЖДЕНИЕ и ЛОГ
'Worksheets("Предупреждение").Visible = xlSheetVeryHidden
'Worksheets("Лог").Visible = xlSheetVeryHidden
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'ищем последнюю занятую строчку в логах
Worksheets("Лог").Unprotect "password"
lastrow = Worksheets("Лог").Range("A60000").End(xlUp).Row
'заносим дату-время выхода из файла
If lastrow > 1 Then Worksheets("Лог").Cells(lastrow, 3) = Now
'скрываем все листы, кроме листа ПРЕДУПРЕЖДЕНИЕ
Worksheets("Предупреждение").Visible = True
For Each sh In ActiveWorkbook.Worksheets
If sh.Name = "Предупреждение" Then
sh.Visible = True
Else
sh.Visible = xlSheetVeryHidden
End If
Next sh
'сохраняемся перед выходом
'ActiveWorkbook.Save
End Sub
Столкнулась с такой вот проблемой: ошибка 1004 Method visible of object worksheet failed выходит при открытии файла только на одном компьютере. Этот же файл на других компьютерах работает также. Везде стоит офис 2016. Надстройки и параметры макросов одинаковые. В чем может быть причина? Причем даже кнопка debug не нажимается, чтобы посмотреть где конкретно сидит причина ошибки... Сталкивался кто-нибудь в таким?
Спасибо Вам большое! У меня получилось, почитала в Вашей ссылочке))) Только вот срабатывает как-то медленно... Ускорить этот процесс можно как-нибудь? Код вот такой получился:
Код
Sub Main()
Const strRootFolder As String = "M:\Production\Мастера\2017\Нормализация"
Dim strFolder As String
strFolder = "M:\Production\Мастера\2017\Нормализация\" & Range("имя_папки").Value
If Dir(strFolder, vbDirectory) = "" Then
MkDir strFolder
End If
Dim New_Wb As Workbook
Set New_Wb = Workbooks.Add
New_Wb.Activate
New_Wb.SaveAs "M:\Production\Мастера\2017\Нормализация\" & Workbooks("Расчет.xlsm").Worksheets("1 норм").Range("имя_папки").Value & "\" & Workbooks("Расчет.xlsm").Worksheets("1 норм").Range("Книга") & ".xlsm", 52
Windows("Расчет.xlsm").Activate
End Sub