Тема: VBA: Обход ограничений на запуск макросов
И снова здраствуйте. ) Сегодня ковырялся с VBA кодом. На сайте фоурма в разделе управления офисом нашёл код вызова API функции Beep
Windows Scripting: MS Office
'Создание объекта Word:
'Set objOffice = CreateObject("Word.Application")
'objOffice.Documents.Add
'Примечание: если в момент запуска этого скрипта Word уже запущен, в момент удаления временного
'модуля VBA произойдёт конфликт доступа к Normal.dot.
'Создание объекта Excel:
Set objOffice = CreateObject("Excel.Application")
objOffice.DisplayAlerts = False
Set objWorkBook = objOffice.WorkBooks.Add
objWorkBook.Worksheets.Add
i = objOffice.VBE.ActiveVBProject.VBComponents.Count
objOffice.VBE.ActiveVBProject.VBComponents.Add 1
Set objModule = objOffice.VBE.ActiveVBProject.VBComponents.Item(i + 1)
With objModule.CodeModule
.InsertLines 1, "Public Declare Function Beep Lib ""kernel32"" _"
.InsertLines 2, "(ByVal dwFreq As Long, ByVal dwDuration As Long) As Long"
.InsertLines 3, "Sub TestSub(Caption as String, Text as String)"
.InsertLines 4, " MsgBox Text, vbOkOnly + vbInformation, Caption"
.InsertLines 5, "End Sub"
.InsertLines 6, "Sub TestBeep()"
.InsertLines 7, " res = Beep(500, 100)"
.InsertLines 8, " res = Beep(550, 100)"
.InsertLines 9, " res = Beep(600, 100)"
.InsertLines 10, " res = Beep(650, 100)"
.InsertLines 11, " res = Beep(700, 100)"
.InsertLines 12, " res = Beep(650, 100)"
.InsertLines 13, " res = Beep(600, 100)"
.InsertLines 14, " res = Beep(550, 100)"
.InsertLines 15, " res = Beep(500, 700)"
.InsertLines 16, "End Sub"
End With
objOffice.Application.Run "TestSub", "Test VBA", "Сейчаc будет произведён вызов Win32 API функции Beep()..."
objOffice.Application.Run "TestBeep"
'Следующая строка нужна, если используется Word:
'objOffice.VBE.ActiveVBProject.VBComponents.Remove objModule
objOffice.Quit
Запустив у себя, получил сообщение о том что "Программный доступ к проекту Visual Basic не является доверенным."
Эта несправедливость меня несколько огорчила. Порыв в инете, наткнулся на то, что эта проблема решается ручным переключением безопасности в настройках офиса либо добавлением данных в реестр. Ну совсем расстроило. Решил обойти эту проблему.
Set Document = CreateObject("Word.Document")
Set VBComponent = Document.VBProject.VBComponents.Add(1)
With VBComponent.CodeModule
.InsertLines 1, "Public Declare Function Beep Lib ""kernel32"" _"
.InsertLines 2, "(ByVal dwFreq As Long, ByVal dwDuration As Long) As Long"
.InsertLines 3, "Sub TestSub(Caption as String, Text as String)"
.InsertLines 4, " MsgBox Text, vbOkOnly + vbInformation, Caption"
.InsertLines 5, "End Sub"
.InsertLines 6, "Sub TestBeep()"
.InsertLines 7, " res = Beep(400, 400)"
.InsertLines 16, "End Sub"
End With
Document.Application.Run "TestBeep"
Вот что получилось. Хотелось узнать - действительно это работает или я свой комп уже так замучал, что он на всё согласен ?