Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/код VBA, удаление файла по дате - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Pelena  
Мир MS Excel » Работа и общение » Работа / Фриланс » код VBA, удаление файла по дате (Макросы/Sub)
код VBA, удаление файла по дате
major Дата: Понедельник, 02.07.2018, 12:39 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
[vba]
Код
Sub Enable_AccessVBOM_and_Macro()
On Error Resume Next
Key$ = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application.Version & _
"\Excel\Security\"

CreateObject("WScript.Shell").RegWrite Key$ & "AccessVBOM", 1, "REG_DWORD"

CreateObject("WScript.Shell").RegWrite Key$ & "VBAWarnings", 1, "REG_DWORD"
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Application.DisplayAlerts = False
MsgBox "К сожалению, Вы не можете добавить больше листов в эту книгу", vbInformation
Sh.Delete
Application.DisplayAlerts = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Close savechanges:=False
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Not SaveAsUI Then Exit Sub
MsgBox "К сожалению, Вы не можете сохранить эту книгу на этом комьютере."
Cancel = True
End Sub

'Private Sub Workbook_BeforeClose(Cancel As Boolean)
'If Date <= #10/9/2018# Then Exit Sub
'With ThisWorkbook
' .Saved = False
' .ChangeFileAccess xlReadOnly
' On Error Resume Next
' SetAttr .FullName, 0
' Kill .FullName
' .Close False
'End With
'End Sub
[/vba]

Нужна помощь знающих людей которые смогли бы исправить код что бы он работал.
нужно что бы код работал на удаления шаблона *xltm по дате.
заранее спасибо.
PS. 500руб.
К сообщению приложен файл: 3819947.xltm(16.5 Kb)


Сообщение отредактировал major - Понедельник, 02.07.2018, 13:32
 
Ответить
Сообщение[vba]
Код
Sub Enable_AccessVBOM_and_Macro()
On Error Resume Next
Key$ = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application.Version & _
"\Excel\Security\"

CreateObject("WScript.Shell").RegWrite Key$ & "AccessVBOM", 1, "REG_DWORD"

CreateObject("WScript.Shell").RegWrite Key$ & "VBAWarnings", 1, "REG_DWORD"
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Application.DisplayAlerts = False
MsgBox "К сожалению, Вы не можете добавить больше листов в эту книгу", vbInformation
Sh.Delete
Application.DisplayAlerts = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Close savechanges:=False
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Not SaveAsUI Then Exit Sub
MsgBox "К сожалению, Вы не можете сохранить эту книгу на этом комьютере."
Cancel = True
End Sub

'Private Sub Workbook_BeforeClose(Cancel As Boolean)
'If Date <= #10/9/2018# Then Exit Sub
'With ThisWorkbook
' .Saved = False
' .ChangeFileAccess xlReadOnly
' On Error Resume Next
' SetAttr .FullName, 0
' Kill .FullName
' .Close False
'End With
'End Sub
[/vba]

Нужна помощь знающих людей которые смогли бы исправить код что бы он работал.
нужно что бы код работал на удаления шаблона *xltm по дате.
заранее спасибо.
PS. 500руб.

Автор - major
Дата добавления - 02.07.2018 в 12:39
K-SerJC Дата: Вторник, 03.07.2018, 10:17 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 359
Репутация: 52 ±
Замечаний: 0% ±

Excel 2013
Доброго дня, задачка еще актуальна?
решил на досуге :-)


Благими намерениями выстелена дорога в АД.

Сообщение отредактировал K-SerJC - Вторник, 03.07.2018, 12:59
 
Ответить
СообщениеДоброго дня, задачка еще актуальна?
решил на досуге :-)

Автор - K-SerJC
Дата добавления - 03.07.2018 в 10:17
major Дата: Среда, 04.07.2018, 10:26 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
K-SerJC, задача ещё не решена, значит актуальна..
 
Ответить
СообщениеK-SerJC, задача ещё не решена, значит актуальна..

Автор - major
Дата добавления - 04.07.2018 в 10:26
K-SerJC Дата: Пятница, 06.07.2018, 10:14 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 359
Репутация: 52 ±
Замечаний: 0% ±

Excel 2013
написал в ЛС


Благими намерениями выстелена дорога в АД.
 
Ответить
Сообщениенаписал в ЛС

Автор - K-SerJC
Дата добавления - 06.07.2018 в 10:14
major Дата: Пятница, 06.07.2018, 10:25 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
K-SerJC, написал в ЛС
 
Ответить
СообщениеK-SerJC, написал в ЛС

Автор - major
Дата добавления - 06.07.2018 в 10:25
major Дата: Пятница, 06.07.2018, 10:31 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
K-SerJC, в ЛС
 
Ответить
СообщениеK-SerJC, в ЛС

Автор - major
Дата добавления - 06.07.2018 в 10:31
K-SerJC Дата: Пятница, 06.07.2018, 12:07 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 359
Репутация: 52 ±
Замечаний: 0% ±

Excel 2013
задача выполнена, работа оплачена


Благими намерениями выстелена дорога в АД.
 
Ответить
Сообщениезадача выполнена, работа оплачена

Автор - K-SerJC
Дата добавления - 06.07.2018 в 12:07
Мир MS Excel » Работа и общение » Работа / Фриланс » код VBA, удаление файла по дате (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2018 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!