Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Интерактивный макрос виснет на Windows 7-10 в Excel 2007-2016, но НЕ виснет на Windows XP 32 bit Excel 2003
 
#1
13.08.2018 16:36:38
Здравствуйте, такой непростой (для меня, как оказалось) вопрос. Есть большой (10к+ строк) интерактивный макрос (игра), использующий функции операционной системы для перехвата событий клавиатуры, мышки и проигрывания звуков (пищалкой и системной программой воспроизведения мультимедиа). Вот такой заголовок у моего макроса:
Код
#if VBA7 then
    Declare PtrSafe Function getTickCount Lib "kernel32" Alias "GetTickCount" () As Long
    Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Declare PtrSafe Function beep Lib "kernel32" Alias "Beep" (ByVal dwFreq As LongPtr, ByVal dwDuration As LongPtr) As LongPtr
    Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Integer, ByVal y As Integer) As Long
    Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
#Else
    Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Declare Function getTickCount Lib "kernel32.dll" Alias "GetTickCount" () As Long
    Declare Function beep Lib "kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
    Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Declare Function SetCursorPos Lib "user32" (ByVal x As Integer, ByVal y As Integer) As Long
    Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
#End If
Проблема заключается в том, что файл очень по-разному ведет себя на разных компах:
Win XP 32 и Excel 2003 (2 разных компа) - работает без проблем
Win XP 32 и Excel 2007 - работает практически без проблем
Win 7 32 и Excel 2007 - периодически зависает с надписью "программа не отвечает", но потом спустя какое-то время продолжает работать
Win 10 64 и Excel 2007 - периодически зависает с надписью "программа не отвечает"(предполагаю, что в ответ на использование клавиатуры, левая кнопка мыши и перемещение мышиного курсора иногда решают эту проблему, а иногда нет, и тогда Ctrl-Break уже не работает, хотя в коде я его не отключал).
Win 8.1 64 и Excel 2016 - виснет практически сразу (музыку играть начинает, но пишет "программа не отвечает" еще до нажатий на какие-либо клавиши и использование мыши. Что завешивает программу, мне непонятно), Ctrl-Break не работает

Поскольку программа отлично (соответственно скорости компьютера) чувствует себя на старых версиях Windows и Excel, и при этом подвисает или виснет на более мощных и современных машинах, для себя я сделал вывод, что проблема в неправильном объявлении внешних по отношению к коду функций (Уточню: в самом коде у меня новые 64-битные типы данных не используются, но, если я не ошибаюсь, это и не обязательно). Приведенный выше заголовок пытается решить эту проблему, но очевидно не решает ее. Лично для меня эта кросс-платформенная неразбериха внутри VBA поставила в тупик. Поэтому буду признателен за любую попытку помочь в решении проблемы.
 
Изменено: левша - 14.08.2018 23:34:31 (правка некорректного ввода )
 
 
 
#2
13.08.2018 17:02:34
Здравствуйте! Описания Win API для Excel версии 2010 и старше (первая часть описаний в #1) необходимо привести в строгое соответствие с документом разработчика (сейчас это не так).
Оформите, пожалуйста, код в #1 с помощью соответствующей кнопки (<...>).
Владимир
 
 
 
#3
13.08.2018 23:28:31
Спасибо большое за ответ и ссылку, кое-что отличалось, подправил, теперь заголовок выглядит так:

Код
#If VBA7 Then
    Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
    Declare PtrSafe Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
    Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
    Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As LongPtr) As Long
#Else
    Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Declare Function GetTickCount Lib "kernel32.dll" () As Long
    Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
    Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Declare Function SetCursorPos Lib "user32" (ByVal x As Integer, ByVal y As Integer) As Long
    Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
#End If
Но на Windows 8.1 64-разрядной с Excel 2016 программа все равно не работает (хотя сначала все же реагирует на клавиатуру). Еще заметил, что попеременные  Application.ScreenUpdating = False/True, которые работают нормально в Excel 2003-2007 (в Excel 2010 не пробовал) тут приводят к тому, что экран в принципе перестает обновляться.
ПС. И я правильно понимаю, что функцией GetTickCount все еще можно пользоваться на 64-разрядных Windows (просто там есть еще GetTickCount64). Или нет? Быстрый тест показал, что зачение она возвращает вроде бы корректное.

Изменено: левша - 13.08.2018 23:29:05
 
 
 
#4
14.08.2018 13:42:46
По пунктам.

1. Мысль тестировать функции по отдельности - правильная
2. Действительно, временные характеристики установки свойства ScreenUpdating для разных платформ могут быть разными (и полагаться на них не следует).  Для тестирования попробуйте выполнить следующий сценарий на различных платформах (отдельно с раскомментированной DoEvents)
Код
Sub test()
 Dim i As Long, t As Double
 t = Timer
 For i = 1 To 1000
   Application.ScreenUpdating = False
   ' DoEvents
   Application.ScreenUpdating = True
 Next i
 Debug.Print Timer - t
End Sub

У меня в конфигурации Win XP, Excel 2003 работает в 10 раз быстрее, чем на Win10, Excel 2016(64)

3. GetTickCount можно использовать, как и все описанные в вышеуказанном документе функции.
Изменено: sokol92 - 14.08.2018 13:43:49
Владимир
 
 
 
#5
14.08.2018 22:22:40
Спасибо за советы. Пока что получилось добиться визуализации игрового экрана (он у меня на рабочем листе формируется), только полностью закомментировав все обращения к Application.ScreenUpdating (что конечно же сделало отображение совсем неприемлемым, но тут уж дело принципа). GetAsyncKeyState не работает, точнее - распознает только нажатие пробела. Курсор мышки ловится, музыка играет. Клавиши мыши, которые тоже читаются через GetAsyncKeyState, тоже не работают. Возможно, виртуальные коды клавиатуры GetAsyncKeyState в Windows 8.1 другие (хотя почему они тогда, хоть и не так стабильно, как в Windows XP SP3, работают на Windows 7 32 бит и 10 64 бит c Excel 2007? Если проблема не в ОС, а в версии Excel, то каким образом эта проблема влияет на работу внешней по отношению к Excel функции из Windows API?).
Изменено: левша - 14.08.2018 22:30:50
 
 
 
#6
15.08.2018 15:58:07
Цитата
левша написал:
GetAsyncKeyState не работает, точнее - распознает только нажатие пробела.
Проверил на Win10, Excel 2016(64). По крайней мере, с клавишами букв и цифр работает.
Код
Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Function GetPressedKey() As String
    Dim cnt As Long, res As String
    For cnt = 32 To 128
        'Get the keystate of a specified key
        If GetAsyncKeyState(cnt) <> 0 Then
            res = res & Chr(cnt)
        End If
    Next cnt
    GetPressedKey = res
End Function

Sub test()
   Application.Wait Now + 2 / 24 / 60 / 60
   MsgBox GetPressedKey
End Sub
Запускаем Test, в течение 2 секунд жмем на кнопки букв и цифр основной клавиатуры.
Виртуальные коды клавиатуры (VK_*) описаны в том же документе разработчика.
Изменено: sokol92 - 15.08.2018 16:10:22
Владимир
 
 
 
#7
16.08.2018 17:19:51
Спасибо, очень удобная тестовая программка. На 64 бит Win 8 и Excel 2016 GetAsyncKeyState работает, клавиши считывает, и кодировка клавиш совпадает с той таблицей, что у меня в программе. Но по ходу программы клавиатура на Excel 2016 висит (а в Excel 2007 нет). Очень странно.
 
 
 
#8
17.08.2018 14:32:22
Если все базовые функции работают, а приложение нет, то одна из причин - нехватка ресурсов конкретного компьютера. Каждая новая версия Excel требует все больших ресурсов...
Владимир
 
 
 
#9
16.10.2018 01:12:44
Спасибо за советы! Хоть и с большим запозданием, но отпишусь, что проблема была все-таки решена. Она была связана с тем, что в более поздних версиях Excel интерпретатор по-другому относится к инструкции Application.EnableEvents = False (при этом оператор DoEvents у меня был расположен однократно в главном цикле программы, и Excel 2003-2007 это нисколько не смущало), поэтому при малейшем "провисании" исполнения главного цикла программы система, насколько я понял, "насильно" отнимала у Excel управление и, тем самым, "завешивала" программу. Стоило расставить DoEvents во всех "трудоемких" и ожидающих пользовательского ввода кусках программы, и "болезнь отступила"... Еще один нюанс оказался связан, насколько я понял, с разделением потоков на ядра процессора в более поздних версиях Excel (2013-2016). Оказалось, что при этом игнорируется очередность исполнения таких вызовов, как Application.ScreenUpdating = True и вызовов форматирования ячеек листа (с точки зрения вычислений Excel это вполне допустимо, но вот графическое отображение от этого сильно пострадало, поэтому пришлось вводить спец. задержки для обновления экрана там, где оно de facto происходило раньше, чем предшествовавшая ему "отрисовка" листа).
Вобщем, вот такое вышло: https://youtu.be/6jyOJsJlLhI
Еще раз спасибо за помощь.
 
 
 
#10
16.10.2018 09:05:22
Ошибка компиляции на PtrSafe - Expected Sub or Function.
Что не так делаю?
 
 
 
#11
16.10.2018 10:05:29
tolikt, Вы о чем? Как вопрос связан с темой?
 
 
 
#12
16.10.2018 12:09:19
Здравствуйте, левша! Поздравляю, Вы проделали большую работу. К необходимости часто вызывать DoEvents я тоже пришел "эмипирическим" путем, правда, в иных ситуациях (например, при работе с подобъектами  Workbook.VBProject).
Успехов!
Изменено: sokol92 - 16.10.2018 13:35:53
Владимир
 
 
 
#13
16.10.2018 22:30:05
Спасибо, старался). Еще одна (неприятная) находка, не относящаяся к теме, но касающаяся производительности макросов (если для кого-то это действительно критично). В ходе парных тестов выяснилось, что активное "тиражирование" пользовательского класса (даже небольшого, на 20 переменных и почти без своего кода) способно очень сильно затормозить исполнение программы (до двух раз при числе копий в коллекции 600+) в сравнении с динамическим массивом из элементов пользовательского типа (несмотря на все необходимые действия по его обслуживанию: добавление и удаление элементов, устранение пробелов и перевыделение памяти).
Повторюсь, это может быть важно в случаях, когда в работе одновременно много копий пользовательского класса и есть требования к скорости исполнения макроса. В остальных же случаях ООП в VBA только помогает.
Изменено: левша - 16.10.2018 22:31:04
 
 
 
Страницы: 1
Наверх