Ошибка the macros in this project are disabled

1
2
3
4
5
6
7
8
9

Sub DeleteFileBlock()
    On Error Resume Next
    Key$ = "HKEY_CURRENT_USERSoftwareMicrosoftOffice14.0ExcelSecurityFileBlock"
    arr = Array("XL2Macros", "XL2Worksheets", "XL3Macros", "XL3Worksheets", _
                "XL4Macros", "XL4Workbooks", "XL4Worksheets")
    For Each Item In arr
        CreateObject("WScript.Shell").RegWrite Key$ & Item, 0, "REG_DWORD"
    Next
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57

Option Explicit
 
Sub Меняем_доверие_к_проектам_VBA_и_уровень_безопасности_в_Word()
 
Dim i As Integer
Dim objWord As Object
Dim objShell As Object
Dim vatDir As String
Dim vatReturn As Currency
Dim Papka As String
Dim AppWord As Word.Application
 
On Error Resume Next
 
Set objWord = CreateObject("Word.Application")
Set objShell = CreateObject("WScript.Shell")
 
For i = 0 To 50
On Error GoTo 150
vatDir = objShell.RegRead( _
"HKEY_CURRENT_USERSoftwareMicrosoftOffice" & objWord.Version & "WordSecurityTrusted LocationsLocation" & i & "Path")
 
If vatDir = ThisWorkbook.Path Then Exit For
If i < 0 Then
150 objShell.RegWrite _
    "HKEY_CURRENT_USERSoftwareMicrosoftOffice" & objWord.Version & "WordSecurityTrusted LocationsLocation" & i & "Description", "Назовите сами", "REG_SZ"
    objShell.RegWrite _
    "HKEY_CURRENT_USERSoftwareMicrosoftOffice" & objWord.Version & "WordSecurityTrusted LocationsLocation" & i & "AllowSubfolders", 1, "REG_DWORD"
    objShell.RegWrite _
    "HKEY_CURRENT_USERSoftwareMicrosoftOffice" & objWord.Version & "WordSecurityTrusted LocationsLocation" & i & "Path", ActiveDocument.Path, "REG_SZ"
    'разрешение доступа к сетевым папкам
    objShell.RegWrite _
"HKEY_CURRENT_USERSoftwareMicrosoftOffice" & objWord.Version & "WordSecurityTrusted LocationsAllowNetworkLocations", 1, "REG_DWORD"
Exit For
End If
Next
 
On Error GoTo 200
vatReturn = objShell.RegRead( _
"HKEY_CURRENT_USERSoftwareMicrosoftOffice" & objWord.Version & "WordSecurityAccessVBOM")
 
If vatReturn = 0 Then
    'за доверительный доступ к проектам VBA отвечает параметр "AccessVBOM"
200 objShell.RegWrite _
    "HKEY_CURRENT_USERSoftwareMicrosoftOffice" & objWord.Version & "WordSecurityAccessVBOM", 1, "REG_DWORD"
    'за уровень безопасности отвечает параметр "Level"
    objShell.RegWrite _
    "HKEY_CURRENT_USERSoftwareMicrosoftOffice" & objWord.Version & "WordSecurityLevel", 1, "REG_DWORD"
    
End If
 
    Set AppWord = New Word.Application
    AppWord.Visible = True
    AppWord.Documents.Open "J:1.doc"
    Word.Application.Quit
 
End Sub

1

If vatDir = ActiveDocument.Path Then Exit For

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87

@echo off :: Macros Access Script by Alex Dragokas echo. echo Утилита включения макросов для MS Office 2003-2013 echo. :ch_Security echo Введите цифру и нажмите кнопку ENTER: echo. echo 1 - Запуск макросов без уведомления. echo 2 - Запуск макросов с разрешения пользователя. echo 3 - Запретить запуск неподписанных макросов (не уведомлять). echo. set ch= set /p "ch=Ваш выбор: " echo. if "%ch%"=="1" set "MacrosLevel=1" if "%ch%"=="2" set "MacrosLevel=2" if "%ch%"=="3" set "MacrosLevel=3" if "%ch%" neq "1" if "%ch%" neq "2" if "%ch%" neq "3" goto ch_Security :ch_VBA echo Хотите включить программный доступ к коду макроса? echo. echo 1 - Да. Разрешить. echo 2 - Нет. Запретить. echo. set ch= set /p "ch=Ваш выбор: " echo. if "%ch%"=="1" set "ProjectLevel=1" if "%ch%"=="2" set "ProjectLevel=0" if "%ch%" neq "1" if "%ch%" neq "2" goto ch_VBA   :: Проверяю, запущен ли хоть один из процессов MS Office :Check call :CheckRun || (echo.& echo НЕЛЬЗЯ продолжить. Сначала нужно завершить все офисные приложения.& echo.& pause & echo.& goto Check)   For %%k in (   HKCUSoftwareMicrosoftOffice   HKCUSoftwareWow6432NodeMicrosoftOffice ) do (   For /F "tokens=5 delims=" %%a in ('reg query "%%k" 2^>NUL ^| findstr /R "^.*[0-9].*"') do (     if "%%a" neq "8.0" (       if "%%a"=="9.0"  (echo Обнаружен MS Office 2000 & call :EnumApps 2003 "%%a")       if "%%a"=="10.0" (echo Обнаружен MS Office XP   & call :EnumApps 2003 "%%a")       if "%%a"=="11.0" (echo Обнаружен MS Office 2003 & call :EnumApps 2003 "%%a")       if "%%a"=="12.0" (echo Обнаружен MS Office 2007 & call :EnumApps 2007 "%%a")       if "%%a"=="13.0" (echo Обнаружен MS Office 2010 & call :EnumApps 2007 "%%a")       if "%%a"=="14.0" (echo Обнаружен MS Office 2010 & call :EnumApps 2007 "%%a")       if "%%a"=="15.0" (echo Обнаружен MS Office 2013 & call :EnumApps 2007 "%%a")       if not Defined isChanges (echo Обнаружена неизвестная версия MS Office & call :EnumApps 2007 "%%a")       echo.     )   ) ) pause exit /B   :EnumApps %1-mso.family %2-key.version   Set "isChanges=true"   For %%k in (     HKCUSoftwareMicrosoftOffice%~2     HKCUSoftwareWow6432NodeMicrosoftOffice%~2   ) do (     For /F "tokens=6 delims=" %%a in ('reg query "%%k" 2^>NUL') do (       if /i "%%a"=="Word" call :ChangeSecurity "%~1" "%~2" "%%a"       if /i "%%a"=="Excel" call :ChangeSecurity "%~1" "%~2" "%%a"       if /i "%%a"=="PowerPoint" call :ChangeSecurity "%~1" "%~2" "%%a"       if /i "%%a"=="Access" call :ChangeSecurity "%~1" "%~2" "%%a"       if /i "%%a"=="Outlook" call :ChangeSecurity "%~1" "%~2" "%%a"     )   ) Exit /B   :ChangeSecurity %1-mso.family %2-key.version %3-Application   echo %~3   if "%~1"=="2003" reg add "HKCUSoftwareMicrosoftOffice%~2%~3Security" /v Level /t REG_DWORD /d %MacrosLevel% /f   if "%~1"=="2007" reg add "HKCUSoftwareMicrosoftOffice%~2%~3Security" /v VBAWarnings /t REG_DWORD /d %MacrosLevel% /f   if /i "%~3" neq "Outlook" if "%~2" neq "9.0" reg add "HKCUSoftwareMicrosoftOffice%~2%~3Security" /v AccessVBOM /t REG_DWORD /d %ProjectLevel% /f Exit /B   :CheckRun   TASKLIST /FI "imagename eq winword.exe" | find /i "winword.exe" && exit /B 1   TASKLIST /FI "imagename eq excel.exe" | find /i "excel.exe" && exit /B 1   TASKLIST /FI "imagename eq powerpnt.exe" | find /i "powerpnt.exe" && exit /B 1   TASKLIST /FI "imagename eq outlook.exe" | find /i "outlook.exe" && exit /B 1   TASKLIST /FI "imagename eq msaccess.exe" | find /i "msaccess.exe" && exit /B 1 Exit /B 0

1

if "%%a"=="16.0" (echo Обнаружен MS Office 2016 & call :EnumApps 2007 "%%a")