Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1 2 След.
RSS
Макрос, выполняемый с заданным периодом автоматически
 
#1
21.04.2019 20:25:55
Доброго времени  суток!
Честно перечитал форумы, но не пойму, в чем загвоздка. Нужно, чтобы файл "Мастер2" каждые 25 секунд перезаписывался с винта под другим именем в другую папку (см. ниже). Макрос такой написал в файле "Мастер2":
Код
Sub Workbook_Open()
If ActiveWorkbook.Name = "Мастер2.xls" Then Call MyMacro
End Sub

Sub MyMacro()
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFile "d:\Мастер2.xls", "d:\Архив_Мастер\" & Date & ".xls", True
Application.OnTime Now() + TimeSerial(0, 0, 25), "MyMacro"
End Sub

При открытии книги в папке d:\Архив_Мастер  образуется файл "21.04.2019.xls" (по сегодняшней дате), а если тот уже существует, то переписывается вместо него. Через 25 сек. выдается скрин. Я уж и  так, и сяк, не могу понять. Прошу помочь.
 
 
 
#2
21.04.2019 20:40:31
Запуск макроса с заданной частотой
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
21.04.2019 20:42:47
Это я видел, не помогло.
 
 
 
#4
21.04.2019 21:02:48
Цитата
Philosopher написал: Это я видел
Видеть мало - нужно попробовать сделать так, как написано в статье. У меня, например, все работает
Согласие есть продукт при полном непротивлении сторон
 
 
 
#5
21.04.2019 21:03:48
Я пробовал сделать много раз. Если нечего сказать по делу- не пишите.
 
 
 
#6
21.04.2019 21:17:06
Цитата
Philosopher написал: Если нечего сказать по делу- не пишите.
Да действительно, лучше покажу
Правда пришлось свои пути прописать и периодичность задать поменьше, для наглядности (5 секунд)
Код
FSO.CopyFile "d:\DOWNLOAD\Мастер2.xls", "d:\DOWNLOAD\Arhive\" & Format(Now, "hh_mm_ss") & ".xls", True
Согласие есть продукт при полном непротивлении сторон
 
 
 
#7
21.04.2019 21:18:06
Philosopher,
1.
Цитата
Philosopher написал:
Если нечего сказать по делу- не пишите.
- а вот это лишнее, вы ж тоже бред пишите
Цитата
Philosopher написал:
Честно перечитал форумы,
. Их не возможно перечитать. А Sanja, с одной стороны подтвердил работоспособность кода, с другой намекнул. что он проделал тоже , только сделал все правильно и у него работает.
2. Sub MyMacro() - поместите не в модуль книги, а в простой модуль.
По вопросам из тем форума, личку не читаю.
 
 
 
#8
21.04.2019 21:56:59
То, что MyMacro надо вставлять в простой модуль, я понял до этого, спасибо. Сейчас частично работает. Не работает то, что файл "21.04.2019.xls" не затирается новым, а остается самая первая, созданная при открытии "2.xls" версия. Файл "2.xls" каждые 25 сек. должен копироваться с диска D:\ и перезаписывать в папке "d:\Arhiv_Master\" собой старую версию файла "21.04.2019.xls".

[CODE][/CODE]
Код
?
1
2
3
4
5
6
7
8
9
10
11		Sub Workbook_Open()
If ActiveWorkbook.Name = "2.xls" Then Application.OnTime Now + TimeValue("00:00:25"), "MyMacro"
End Sub

Sub MyMacro()
If ActiveWorkbook.Name = "2.xls" Then
Application.OnTime Now + TimeValue("00:00:25"), "MyMacro"
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFile "d:\2.xls", "d:\Arhiv_Master\" & Date & ".xls", True
End If
End Sub

Изменено: Philosopher - 22.04.2019 09:35:10
 
 
 
#9
21.04.2019 21:59:00
Цитата
Philosopher написал:
Я пробовал сделать много раз. Если нечего сказать по делу- не пишите.
Philosopher, а повежливее нельзя? Иначе Вам в ответ напишут: "Не можете сделать правильно - Ваша проблема".
 
 
 
#10
21.04.2019 22:01:14
1. Код следует оформлять соответствующим тегом. Ищите такую кнопку (см. скрин) и исправьте своё сообщение.
2. Код копируйте при русской раскладке клавиатуры - не будет проблем с кириллицей.
 
 
 
#11
21.04.2019 22:03:37
Philosopher,  Читайте внимательно название данное Вами теме и сравните с тем что не получается (хотя странно это) , описанное в #8.
По вопросам из тем форума, личку не читаю.
 
 
 
#12
21.04.2019 22:04:30
Цитата
Philosopher написал: Хотелось бы верный текст от и до получить
По ссылке выше код верный,но Вы, почему-то, не хотите его использовать
Согласие есть продукт при полном непротивлении сторон
 
 
 
#13
21.04.2019 22:10:31
Переоформил. Сейчас частично работает. Не работает то, что файл "21.04.2019.xls" не затирается новым, а остается самая первая, созданная при открытии "2.xls" версия. Файл "2.xls" каждые 25 сек. должен копироваться с диска D:\ и перезаписывать в папке "d:\Arhiv_Master\" собой старую версию файла "21.04.2019.xls".
Код
Sub Workbook_Open()
If ActiveWorkbook.Name = "2.xls" Then Application.OnTime Now + TimeValue("00:00:25"), "MyMacro"
End Sub

Sub MyMacro()
If ActiveWorkbook.Name = "2.xls" Then
Application.OnTime Now + TimeValue("00:00:25"), "MyMacro"
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFile "d:\2.xls", "d:\Arhiv_Master\" & Date & ".xls", True
End If
End Sub
Изменено: Philosopher - 21.04.2019 22:13:10
 
 
 
#14
21.04.2019 22:14:36
Цитата
Юрий М написал:
исправьте своё сообщение
Исправить - это значит зайти в своё сообщение и исправить (отредактировать его), а не писать код в новом.
 
 
 
#15
21.04.2019 22:15:38
Цитата
Sanja написал:
По ссылке выше код верный
Верный, но не подходит под задачу. Код делает копию файла и все работает, только делает копию последнего сохраненного файла.
По вопросам из тем форума, личку не читаю.
 
 
 
#16
21.04.2019 22:17:37
Дописать строку сохранения файла перед его копированием
Согласие есть продукт при полном непротивлении сторон
 
 
 
#17
21.04.2019 22:20:53
Хоть Вы и рекомендовали мне здесь больше не писать, рискну
В модуль ЭтаКнига
Код
Sub Workbook_Open()
    If ActiveWorkbook.Name = "Мастер2.xls" Then Call NextRun
End Sub
В основной модуль
Код
Dim TimeToRun

Sub MyMacro()
With ThisWorkbook.Worksheets("Лист1")
    .Range("A" & .Cells(.Rows.Count, 1).End(xlUp).Row + 1) = Format(Now, "DD.MM.YYYY hh:mm:ss")
End With
ThisWorkbook.Save
Set FSO = CreateObject("Scripting.FileSystemObject")
'свои пути подставьте
FSO.CopyFile "d:\DOWNLOAD\Мастер2.xls", "d:\DOWNLOAD\Arhive\" & Date & ".xls", True
Call NextRun
End Sub

Sub NextRun()
    TimeToRun = Now + TimeValue("00:00:05") 'период пять секунд
    Application.OnTime TimeToRun, "MyMacro"
End Sub

Sub Finish()
    Application.OnTime TimeToRun, "MyMacro", , False
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#18
21.04.2019 22:24:43
Sanja, спасибо, но это совсем не то. Тут какие-то ячейки со временем перезаписи, мне это совсем не надо. Вот задача, дублирую: Файл "2.xls" каждые 25 сек. должен копироваться с диска D:\ и перезаписывать в папке "d:\Arhiv_Master\" собой старую версию файла "21.04.2019.xls".
 
 
 
#19
21.04.2019 22:28:26
Philosopher,  прочтите мои сообщения!!!
По вопросам из тем форума, личку не читаю.
 
 
 
#20
21.04.2019 22:28:32
Цитата
Philosopher написал: Тут какие-то ячейки со временем перезаписи
Эти ячейки вставлены в код для демонстрации того, что файл именно ЗАМЕНЯЕТСЯ новым, каждые 5 секунд, а не остается самая первая версия. Эти строки кода можно удалить.
Согласие есть продукт при полном непротивлении сторон
 
 
 
#21
21.04.2019 22:33:02
Цитата
БМВ написал:
Philosopher ,  прочтите мои сообщения!!!
Я читаю, спасибо, но предметного ответа не вижу.
 
 
 
#22
21.04.2019 22:53:01
Sanja, я понял, сделал так и получил, что уже имел сегодня днем.  Скрины . Здесь я должен добавить, о чем забыл сказать выше, что во время всех этих манипуляций файл "Мастер2.xls" ОТКРЫТ.
Изменено: Philosopher - 21.04.2019 22:55:31
 
 
 
#23
21.04.2019 22:56:47
Макрос на перезапись из какого файла запускается?
Согласие есть продукт при полном непротивлении сторон
 
 
 
#24
21.04.2019 23:58:56
Макрос запускается из "Мастер2.xls", автоматически при его открытии.
 
 
 
#25
22.04.2019 00:35:33
Сообщение №14
 
 
 
#26
22.04.2019 01:34:44
Потыркался, но так и не решил до конца. Если при закрытии Книги сохранять измен-я, то все ОК, а если отказаться от сохран-я измен-й, то Книга принудительно тут же открывается. Сейчас код такой:
Код
Sub Workbook_Open()
  Application.DisplayAlerts = 0
  If ActiveWorkbook.Name = "Мастер2.xls" Then Call NextRun
  Application.DisplayAlerts = 1
End Sub

Dim TimeToRun
Sub MyMacro()
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFile "d:\Мастер2.xls", "d:\Архив_Мастер\" & Date & ".xls", True
Call NextRun
End Sub

Sub NextRun()
    TimeToRun = Now + TimeValue("00:00:17")
    Application.OnTime TimeToRun, "MyMacro"
End Sub

Sub Finish()
    Application.OnTime TimeToRun, "MyMacro", , False
End Sub
Изменено: Philosopher - 22.04.2019 11:47:48
 
 
 
#27
22.04.2019 10:16:25
Затем я еще удалил процедуру Finish(), т.к. в моем случае она не нужна и нигде не запускается.
 
 
 
#28
22.04.2019 10:20:14
Цитата
Philosopher написал:
Затем я еще удалил процедуру Finish(), т.к. в моем случае она не нужна и нигде не запускается.
Ну если хотите получить ошибку, если между Вашими 25сек книга будет закрыта, а время следующего старта назначено, то можете не использовать.
Изменено: БМВ - 22.04.2019 10:20:51
По вопросам из тем форума, личку не читаю.
 
 
 
#29
22.04.2019 11:49:14
БМВ отчасти прав. НО по-любому, как теперь выясняется, "Мастер2" принудительно открывается после закрытия, если перед этим самым закрытием отказаться от сохранения изменений. Так и не решен вопрос, увы.
 
 
 
#30
22.04.2019 11:57:08
Цитата
Philosopher написал:
БМВ отчасти прав
Даже интересно, в какой части я не прав.  Первый вопрос- макрос не запускается - и это решено. Теперь серия других вопросов, запускается даже когда не нужно, копируется не то что хотелось . Ну так вы об этом и не спрашивали, при этом Sanja подготовил уже вам все на 99%.
По вопросам из тем форума, личку не читаю.
 
 
 
Страницы: 1 2 След.
Наверх