Макрос для excel автосохранение - Word и Excel - помощь в работе с программами

Добрый день, уважаемые форумчане!

Сразу говорю, что в Excel я чайник, занимаюсь совершенно иным. Однако же, возникла необходимость…

Что нужно — чтобы в процессе работы с книгой Excel периодически выполнялось сохранение файла (текущей книги). Не автосохранение, которое можно прописать в Excel, а именно сохранение — эквивалент того, что происходит по Ctrl/S. Это нужно, чтобы Dropbox увидел изменившийся файл и создал новую версию файла — таким образом, мы получаем последовательность версий, отстоящих друг от друга, например, на 3 минуты, и если бухгалтер под действием выкуренной дури накосячит — чтобы можно было взять файл отчёта по состоянию на N минут назад. Всё бы хорошо, но автосохранение не трогает сам файл, с которым работают, — вместо этого некие данные пишутся в некие другие файлы, по которым Excel потом может что-то там восстановить — но это совсем не то, что нам требуется.

Порывшись немного в нете, сделал макрос (текст чуть ниже). Всё работает замечательно, каждые 3 минуты файл сохраняется, но теперь другая беда — кнопки «Отменить действие» и «Отменить отмену» при работе макроса неактивны.
Т.е., если я даже просто вношу число в ячейку, то удалить его можно только затерев вручную, отмены нет.

А теперь, собственно, вопросы…

1. Почему не работают кнопочки Undo / Redo, и как сделать, чтобы они работали?
2. Можно ли вызывать ActiveWorkbook.Save() по событиям таймера, программируя их с нужным интервалом, а не крутить в тесном цикле?
3. Возможно, проблему с регулярным сохранением файла можно решить вообще без макроса? (программировать бухгалтера на нажатие Ctrl/S каждые 3 минуты не предлагать )))

Sub Delay(dblSecs As Double) Const OneSec As Double = 1# / (1440# * 60#) Dim dblWaitTil As Date dblWaitTil = Now + OneSec * dblSecs Do Until Now > dblWaitTil DoEvents ' Allow windows messages to be processed Loop End Sub





  


                       
  




Sub Auto_Open()
 Do Until False
  Delay (180) ' Save the document every 180 seconds
  ActiveWorkbook.Save
 Loop
End Sub

Источник

Макрос автосохранения файлов Excel

fairylive

Дата: Вторник, 12.12.2017, 17:08 |
Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 122

Репутация:
4
±

Замечаний:
0% ±

Excel 2016

Всем привет! У меня случился нереальный облом. Сохранил файл с изменениями которых быть не должно. Пол дня (хорошо хоть всего пол дня) работы на смарку. Давайте подумаем как можно сделать так чтобы такое предупредить в будущем. Такое уже не первый раз случается. Но бывало спасало автосохранение. Сейчас оно не помогло.
Продумать такой случай который и произошел у меня.
Я открыл файл.
Сделал изменения.
Нажал сохранить.
Закрыл файл.
Потом понял что произошло что-то не то. Файл надо было сохранить как!
Разумеется никаких копий автосохранения не сохранилось. Прошёлся recuva — пусто. Искал в папке где лежит сам файл и в папке автосохранения Excel. В интернете пишут что если бы я перезаписал его или удалил — шансы бы были. А так ничего не поделаешь.
Что-то подобное делается в автокаде. Там всегда есть копия — bak рядом с оригиналом. То есть предыдущая копия файла до нажатия кнопки сохранить. Плюс там очень хорошо продуманное автосохранение. Из темпа можно надёргать различные копии файла автосохранённые в разное время в течении дня.
Excel 2013 русский у меня если что.
Мне видится такое решение:
Открывается файл.
Сразу автоматом сохраняется как файл.bak — причём без какого-то участия пользователя.
Если файл открывается повторно а уже файл.bak есть то пусть создается файл1.bak
Ну либо как-то ещё.
Может кто сталкивался с таким?
Задача вроде не особо сложная. ДУмаю и сам бы справился. Но пока не понимаю как добавить такое событие (после открытия любого файла). Где должен макрос лежать?

Ответить

al-Ex

Дата: Вторник, 12.12.2017, 18:49 |
Сообщение № 2

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 190

Репутация:
59
±

Замечаний:
0% ±

Excel 2010

после открытия любого файла). Где должен макрос лежать?

В личной книге макросов. PERSONAL.XLSB или в надстройке.

Сообщение отредактировал al-Ex — Вторник, 12.12.2017, 18:51

Ответить

berya

Дата: Вторник, 12.12.2017, 18:49 |
Сообщение № 3

Группа: Проверенные

Ранг: Новичок

Сообщений: 27

Репутация:
0
±

Замечаний:
0% ±

Excel 2007

Добрый день
Создает резервную копию файла в папке «_Резерв» в том же каталоге где и запускается файл

В модуль «Эта книга» помещаете:
[vba]

Код

Private Sub Workbook_Open()
reserv
End Sub

[/vba]

в модуль1 (или любой другой:

[vba]

Код

Sub reserv()

Dim strPath As String
Dim strDate As String
    Application.ScreenUpdating = False
    strPath = ThisWorkbook.Path
    If Len(Dir(strPath & «_Резерв», vbDirectory)) = 0 Then MkDir strPath & «_Резерв»
    On Error Resume Next
    x = GetAttr(strPath) And 0
    If Err = 0 Then
        strDate = Format(Now, «yyyy_mm_dd_hh-mm»)
        FileNameXls = strPath & «_Резерв» & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) — 5) & «_» & strDate & «.xlsb»
        ActiveWorkbook.SaveCopyAs Filename:=FileNameXls
    Else
        MsgBox «Ошибка сохранения!!!!», vbCritical
    End If
    Application.ScreenUpdating = True
End Sub

[/vba]

Ответить

SLAVICK

Дата: Среда, 13.12.2017, 09:52 |
Сообщение № 4

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация:
766
±

Замечаний:
0% ±

2019

Разумеется никаких копий автосохранения не сохранилось.

Посмотрите на всякий случай тут:
c:UsersПОЛЬЗОВАТЕЛЬAppDataLocalMicrosoftOfficeUnsavedFiles
иногда сохраняются даже сохраненные файлы.

А вообще — лучший способ отката — всегда сохранять файлы как новые — с добавлением текущей даты и времени — потом легко можно откатится на нужный вариант(дату) лишнее — просто удаляете.
Тут есть пример и описание
Иногда файлы ловят неисправимые глюки(по разным причинам), и потом работавший долгое время файл может просто перестать открываться т.е. RIP.

Иногда все проще чем кажется с первого взгляда.

Ответить

fairylive

Дата: Среда, 13.12.2017, 15:23 |
Сообщение № 5

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 122

Репутация:
4
±

Замечаний:
0% ±

Excel 2016

Добрый день
Создает резервную копию файла в папке «_Резерв» в том же каталоге где и запускается файл

Это в каждый файл придётся вставлять этот макрос? На автоматизацию не очень похоже. Или я не уловил что-то? Попозже попробую в деле.

Посмотрите на всякий случай тут:
c:UsersПОЛЬЗОВАТЕЛЬAppDataLocalMicrosoftOfficeUnsavedFiles
иногда сохраняются даже сохраненные файлы.

Смотрел, там пусто.

Что-то мне сдаётся средствами экселя такое не сделать. Перехватывающий скрипт какой-то мутить?

Ответить

berya

Дата: Среда, 13.12.2017, 16:47 |
Сообщение № 6

Группа: Проверенные

Ранг: Новичок

Сообщений: 27

Репутация:
0
±

Замечаний:
0% ±

Excel 2007

fairylive,
Добрый день.
Создаете файл personal.xlsb — помещаете его в папку …..AppDataRoamingMicrosoftExcelXLSTART
В модуль сохраняете

[vba]

Код

Sub reserv()

Dim strPath As String
Dim strDate As String
Dim x
Dim FileNameXls
    Application.ScreenUpdating = False
    strPath = ActiveWorkbook.Path
    If Len(Dir(strPath & «_Резерв», vbDirectory)) = 0 Then MkDir strPath & «_Резерв»
    On Error Resume Next
    x = GetAttr(strPath) And 0
    If Err = 0 Then
        strDate = Format(Now, «yyyy_mm_dd_hh-mm»)
        FileNameXls = strPath & «_Резерв» & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) — 5) & «_» & strDate & «.xlsb»
        ActiveWorkbook.SaveCopyAs Filename:=FileNameXls
    Else
        MsgBox «Ошибка сохранения!!!!», vbCritical
    End If
    Application.ScreenUpdating = True
End Sub

[/vba]

В модуль «Эта книга» файла с которым Вы работаете

[vba]

Код

Private Sub Workbook_Open()
    With ThisWorkbook
        Application.Run («personal.xlsb!reserv»)
    End With
End Sub

[/vba]
Автоматизация заключается в том, что при каждом открытии Вашего рабочего файла создается резервная копия файла.
Только обратите внимание на расширение файла — у меня оно xlsb
Также макрос reserv — можно повесить на кнопку и перед какой — то сложной операцией запускать

Ответить

fairylive

Дата: Среда, 13.12.2017, 17:19 |
Сообщение № 7

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 122

Репутация:
4
±

Замечаний:
0% ±

Excel 2016

Автоматизация заключается в том, что при каждом открытии Вашего рабочего файла создается резервная копия файла.

Да спасибо, я именно так и думал. Но ваш вариант скорей подойдёт для людей которые что-то понимают в макросах и как минимум долго работают с одним и тем же файлом. Изо дня в день. У меня по сути объём работы такой что один файл может создаваться от 10 минут до 8 часов. Несколько дней — исключительная редкость. Но здесь тогда пользователи сами создают резервные копии.

Ответить

krosav4ig

Дата: Среда, 13.12.2017, 17:28 |
Сообщение № 8

Группа: Друзья

Ранг: Старожил

Сообщений: 2346

Репутация:
989
±

Замечаний:
0% ±

Excel 2007,2010,2013

В PERSONAL.XSLB в модуль ЭтаКнига
[vba]

Код

Private WithEvents app As Application
Private Sub app_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
    On Error GoTo er
    Dim LastSaved$, Backup$
    LastSaved = Wb.BuiltinDocumentProperties(«Last Save Time»)
    Backup = Wb.Path & «» & Replace(LastSaved, «:», «.») & » » & Wb.Name
    If Wb Is Me Or Wb.IsAddin Then Exit Sub
    If Wb.FullName <> Wb.Name And Not SaveAsUI And MsgBox(«Сделать бэкап?», 36) = 6 Then
        Shell Join(Array(«cmd /c copy «, Wb.FullName, » «, Backup, » /y»), «»»»)
        Do While Dir$(Backup) = «»
            DoEvents
        Loop
    ElseIf SaveAsUI Then
        MsgBox «Тут можно чего-то написать»
    End If
er:
End Sub
Private Sub Workbook_Open()
    Set app = Application
End Sub

[/vba]
и перезапустить Excel

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Ответить

fairylive

Дата: Пятница, 15.12.2017, 12:27 |
Сообщение № 9

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 122

Репутация:
4
±

Замечаний:
0% ±

Excel 2016

krosav4ig, спасибо, походу дела то что надо!

Не совсем понятно как работает. Можете пояснить немного код?
Вот эта строчка должна заменять текущий бэкап или нет?

Код

Backup = Wb.Path & «» & Replace(LastSaved, «:», «.») & » » & Wb.Name

Ещё при сохранении КАК выскакивает «Тут можно чего-то написать». Так и должно быть?

И пожалуй стоит сохранять эти бэкапы в отдельную папку в той же папке где находится исходник (Или может вообще в какую-то общую папку, например на сервере с рэйдмассивом, чтобы повысить шансы выживания файлов). А то слишком много копий появляется в текущей папке, если поставить это дело на автомат (имею ввиду если убрать всплывающее окно с вопросом Сделать бэкап).

Сообщение отредактировал fairylive — Пятница, 15.12.2017, 12:28

Ответить

fairylive

Дата: Пятница, 15.12.2017, 12:36 |
Сообщение № 10

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 122

Репутация:
4
±

Замечаний:
0% ±

Excel 2016

berya, сделал как вы сказали — поместил тоже в книгу Personal.xlsb (сейчас там только ваш код).

После открытия файла спотыкается на строчке

[vba]

Код

strPath = ActiveWorkbook.Path

[/vba]

Причем 1 раз открывает с ошибкой второй раз нормально. Но бэкапы не делаются.

К сообщению приложен файл:

7618942.png
(17.4 Kb)

Сообщение отредактировал fairylive — Пятница, 15.12.2017, 12:45

Ответить

fairylive

Дата: Пятница, 15.12.2017, 14:52 |
Сообщение № 11

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 122

Репутация:
4
±

Замечаний:
0% ±

Excel 2016

Вот подправил — работает как я и хотел. Создаются бэкапы Excel в отдельную папку в той же папке где исходник.
[vba]

Код

Private WithEvents app As Application
Private Sub app_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
    On Error GoTo er
    Dim LastSaved$, Backup$
    LastSaved = Wb.BuiltinDocumentProperties(«Last Save Time»)
    If Dir(Wb.Path & «excel_bak», vbDirectory) = «» Then MkDir (Wb.Path & «excel_bak»)
    Backup = Wb.Path & «excel_bak» & Replace(LastSaved, «:», «.») & » » & Wb.Name
    If Wb Is Me Or Wb.IsAddin Then Exit Sub
    If Wb.FullName <> Wb.Name And Not SaveAsUI Then ‘And MsgBox(«Сделать бэкап?», 36) = 6 Then
        Shell Join(Array(«cmd /c copy «, Wb.FullName, » «, Backup, » /y»), «»»»)
        Do While Dir$(Backup) = «»
            DoEvents
        Loop
    ElseIf SaveAsUI Then
        ‘MsgBox «Тут можно чего-то написать»
    End If
er:
End Sub
Private Sub Workbook_Open()
    Set app = Application
End Sub

[/vba]

Сообщение отредактировал fairylive — Пятница, 15.12.2017, 14:53

Ответить

fairylive

Дата: Пятница, 15.12.2017, 15:25 |
Сообщение № 12

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 122

Репутация:
4
±

Замечаний:
0% ±

Excel 2016

Всплыл БАГ. При работе с сетевыми файлами. В связи с отсутствием админских прав. Появляется ошибка что нет прав если попытаться сохранить. Плюс в чужих папках появляется папка excel_bak даже если выбором было сохранить как.

Так же при работе с сетевыми файлами появляются тормоза при закрытии файла. Причём даже если просто зайти ничего не сделать (просто посмотреть) и выйти.

UPD. Тормоза не связаны с макросом или файлом personal.xlsb — удалял его и ничего не менялось. При этом файлы xlsx работают нормально. xls при выходе подвисают секунд на 10. Возможно связано с последним декабрьским обновлением винды. В инете чувак один писал на англоязычном форуме что у него файлы офиса накрылись. Но я сейчас откатил это обновление и тормоза не пропали.

Сообщение отредактировал fairylive — Пятница, 15.12.2017, 17:35

Ответить

Источник

0 / 0 / 0

Регистрация: 10.05.2016

Сообщений: 3

30.05.2016, 23:27. Показов 5794. Ответов 1

Помогите, пожалуйста с таким вопросом. Нужно чтобы документ автоматически сохранялся с периодичностью в секунду. Автосохранение необходимо производить в этот же документ или в любой заданный.

KoGG

5590 / 1580 / 406

Регистрация: 23.12.2010

Сообщений: 2,366

Записей в блоге: 1

31.05.2016, 13:29

Module1 :

Visual Basic

Public TimerFlag As Boolean
 
Sub Timer_Tick()
    Dim MyEarliestTime As Variant
    If TimerFlag Then
        ThisWorkbook.Save
        MyEarliestTime = Now + TimeValue("00:00:01")
        Application.OnTime EarliestTime:=MyEarliestTime, Procedure:="Timer_Tick"
    End If
End Sub

Модуль ЭтаКнига:

Visual Basic

Private Sub Workbook_Open()
    TimerFlag = True
    Call Timer_Tick
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    TimerFlag = False
    ThisWorkbook.Save
End Sub

Добавлено через 1 час 2 минуты
У меня тут всплыла закрытая книга.
Лучше так:

Visual Basic

Public TimerFlag As Boolean
Public MyEarliestTime As Variant
 
Sub Timer_Tick()
    If TimerFlag Then
        ThisWorkbook.Save
        MyEarliestTime = Now + TimeValue("00:00:01")
        Application.OnTime EarliestTime:=MyEarliestTime, Procedure:="Timer_Tick"
    End If
End Sub

Visual Basic

Private Sub Workbook_Open()
    TimerFlag = True
    Call Timer_Tick
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    TimerFlag = False
    Application.OnTime EarliestTime:=MyEarliestTime, Procedure:="Timer_Tick", Schedule:=False
    ThisWorkbook.Save
End Sub

Источник

Как создать резервную копию книги с сегодняшней датой

На чтение 2 мин. Просмотров 2.7k.

Что делает макрос: Макрос позволяет создать резервную копию книги и сохраняет ваш файл в папке с сегодняшней датой.

Содержание

Как это работает
Код макроса
Как работает этот код
Как использовать

Как это работает

Хитрость данного макроса заключается в сопоставлении частей файла. Новое имя файла состоит из трех частей: путь, исходный файл и сегодняшняя дата.

Путь определяем с помощью свойства Path объекта ThisWorkbook.
Второй частью нового файла является исходное имя файла. Мы используем свойство Name объекта ThisWorkbook.
Текущую дату берем с помощью функции Date. Вы заметите, что мы форматируем дату (Format (Date, «мм-дд-гг»)). Это происходит потому, что по умолчанию функция даты возвращает мм / дд / гггг. Мы используем дефис вместо слэша, иначе это вызовет ошибку при попытке сохранить файл (Windows не позволяет использовать «/» в именах файлов.)

Код макроса

Sub SozdatRezervnuyuKopiyu()
'Сохранить книгу с новым именем
ThisWorkbook.SaveCopyAs _
Filename:=ThisWorkbook.Path & "" & _
Format(Date, "mm-dd-yy") & " " & _
ThisWorkbook.Name
End Sub

Как работает этот код

Используем одну единственную строку, которая с помощью метода SaveCopyAs создает новый имя файла и использует метод для сохранения файла.

Как использовать

Для реализации этого макроса, вы можете скопировать и вставить его в стандартный модуль:

Активируйте редактор Visual Basic, нажав ALT + F11.
Щелкните правой кнопкой мыши имя проекта / рабочей книги в окне проекта.
Выберите Insert➜Module.
Введите или вставьте код во вновь созданном модуле.

Источник

Создание резервных копий ценных файлов

При работе с некоторыми особо ценными файлами, бывает необходимо периодически в течение рабочего дня сохранять его промежуточные версии, чтобы, при необходимости, иметь возможность к ним вернуться. Выполнять постоянно вручную команды «Файл — Сохранить как» утомительно, да и случайно можно вместо «Сохранить как» нажать на «Сохранить», похоронив этим большой кусок работы.

Если у вас Excel 2010, то кроме стандартного автосохранения у вас должна работать система версий — каждый раз при автосохранении Excel делает отдельную копию вашего текущего файла и (даже!) при выходе из программы и отрицательном ответе на вопрос «Сохранить изменения в файле?» все равно сохраняет временную копию. Добраться до этих временных копий можно через вкладку Файл — Сведения — Версии (File — Properties — Versions):

Для своих проектов я в итоге пришел к другому решению — написал макрос, который сохраняет текущую книгу в заданную папку, добавляя к имени книги текущую дату и время в формате ДД-ММ-ГГ ЧЧ-ММ (например Мой проект 12-10-12 07-35). Периодически запуская этот макрос на ключевых этапах работы с файлом, я получаю список из энного количества файлов-версий рабочей книги и, соответственно, легко могу откатиться к нужному варианту в прошлом.

Откройте редактор Visual Basic, выбрав на вкладке Разработчик — Редактор Visual Basic (Developer — Visual Basic Editor) или нажав ALT+F11. Вставьте через меню Insert — Module новый пустой модуль и скопируйте туда текст этого макроса:

Sub Backup_Active_Workbook()
    Dim x As String
    strPath = "c:TEMP"     'папка для сохранения резервной копии
    On Error Resume Next
    x = GetAttr(strPath) And 0
    If Err = 0 Then ' если путь существует - сохраняем копию книги, добавляя дату-время
        strDate = Format(Now, "dd-mm-yy hh-mm")
        FileNameXls = strPath & "" & "Мой проект" & " " & strDate & ".xls"   'или xlsm
        ActiveWorkbook.SaveCopyAs Filename:=FileNameXls
    Else 'если путь не существует - выводим сообщение
        MsgBox "Папка " & strPath & " недоступна или не существует!", vbCritical
    End If
End Sub

Естественно, путь к папке (C:TEMP) и имя файла (Мой проект) надо заменить на свои.

Если ваша папка для сохранения находится на сетевом диске, то ее адрес можно прописать, используя IP-адрес сервера, например:

strPath = "\192.168.1.1Папка для бэкапов"

Еще одно, возможно, полезное дополнение в том, что имя файла может быть не постоянным, а браться из заданной ячейки листа, где его либо вводит пользователь, либо оно автоматически формируется формулами (например, функцией СЦЕПИТЬ и т.д.). Тогда необходимо будет чуть подправить следующую строку:

FileNameXls = strPath & "" & Sheets("Лист1").Range("A1").Value & " " & strDate & ".xls"

Предполагается, что имя файла берется с листа Лист1 из ячейки А1.

Ссылки по теме

Автоматический бэкап в заданную папку с помощью надстройки PLEX
Что такое макросы, куда вставлять код макроса на VBA, как их использовать?

Источник