Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1 2 След.
RSS
Не работает код макроса в 64 битной системе!
 
#1
23.11.2017 17:47:58
Помогите разобраться, есть два компьютера оба 64-bit , на одном компьютере работает без проблем , на другом выдает ошибку
Код
?
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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
'''''' normal module code
#If VBA7 Then
Option Explicit
 
Private Type POINTAPI
       X As Long
       Y As Long
End Type
 
Private Type MOUSEHOOKSTRUCT
       pt As POINTAPI
       hwnd As Long
       wHitTestCode As Long
       dwExtraInfo As Long
End Type
 
Private Declare PtrSafe Function FindWindow Lib "user32" _
                                       Alias "FindWindowA" ( _
                                                       ByVal lpClassName As String, _
                                                       ByVal lpWindowName As String) As LongPtr
 
Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" _
                                       Alias "GetWindowLongA" ( _
                                                       ByVal hwnd As Long, _
                                                       ByVal nIndex As Long) As LongPtr
 
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
                                       Alias "SetWindowsHookExA" ( _
                                                       ByVal idHook As Long, _
                                                       ByVal lpfn As Long, _
                                                       ByVal hmod As Long, _
                                                       ByVal dwThreadId As Long) As LongPtr
 
Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _
                                                       ByVal hHook As Long, _
                                                       ByVal nCode As Long, _
                                                       ByVal wParam As Long, _
                                                       lParam As Any) As Long
 
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
                                                       ByVal hHook As Long) As LongPtr
 
'Private Declare PtrSafe  Function PostMessage Lib "user32.dll" _
'                                         Alias "PostMessageA" ( _
'                                                         ByVal hwnd As Long, _
'                                                         ByVal wMsg As Long, _
'                                                         ByVal wParam As Long, _
'                                                         ByVal lParam As Long) As LongPtr
 
Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
                                                       ByVal xPoint As Long, _
                                                       ByVal yPoint As Long) As LongPtr
 
Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" ( _
                                                       ByRef lpPoint As POINTAPI) As LongPtr
 
Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const HC_ACTION As Long = 0
Private Const GWL_HINSTANCE As Long = (-6)
 
'Private Const WM_KEYDOWN As Long = &H100
'Private Const WM_KEYUP As Long = &H101
'Private Const VK_UP As Long = &H26
'Private Const VK_DOWN As Long = &H28
'Private Const WM_LBUTTONDOWN As Long = &H201
 
Private mLngMouseHook As Long
Private mComboBoxHwnd As Long
Private mbHook As Boolean
Private mCtl As MSForms.Control
Dim n As Long
Sub HookComboBoxScroll(frm As Object, ctl As MSForms.Control)
Dim lngAppInst As Long
Dim hwndUnderCursor As Long
Dim tPT As POINTAPI
    GetCursorPos tPT
    hwndUnderCursor WindowFromPoint(tPT.X, tPT.Y)
    If Not frm.ActiveControl Is ctl Then
            ctl.SetFocus
    End If
    If mComboBoxHwnd <> hwndUnderCursor Then
            UnhookComboBoxScroll
            Set mCtl = ctl
            mComboBoxHwnd = hwndUnderCursor
            lngAppInst = GetWindowLong(mComboBoxHwnd, GWL_HINSTANCE)
            ' PostMessage mComboBoxHwnd, WM_LBUTTONDOWN, 0&, 0&
            If Not mbHook Then
                    mLngMouseHook = SetWindowsHookEx( _
                                                    WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
                    mbHook = mLngMouseHook <> 0
            End If
    
End Sub
 
Sub UnhookComboBoxScroll()
    If mbHook Then
               Set mCtl = Nothing
            UnhookWindowsHookEx mLngMouseHook
            mLngMouseHook = 0
            mComboBoxHwnd = 0
            mbHook = False
       End If
        
End Sub
 
Private Function MouseProc( _
            ByVal nCode As Long, ByVal wParam As Long, _
            ByRef lParam As MOUSEHOOKSTRUCT) As Long
Dim idx As Long
       On Error GoTo errH
    If (nCode = HC_ACTION) Then
            If WindowFromPoint(lParam.pt.X, lParam.pt.Y) = mComboBoxHwnd Then
                    If wParam = WM_MOUSEWHEEL Then
                               MouseProc = True
'                                If lParam.hwnd > 0 Then
'                                        PostMessage mComboBoxHwnd, WM_KEYDOWN, VK_UP, 0
'                                Else
'                                        PostMessage mComboBoxHwnd, WM_KEYDOWN, VK_DOWN, 0
'                                End If
'                                PostMessage mComboBoxHwnd, WM_KEYUP, VK_UP, 0
                               If lParam.hwnd > 0 Then idx = -1 Else idx = 1
'                             idx = idx + mCtl.ListIndex
'                             If idx >= 0 Then mCtl.ListIndex = idx
                            idx = idx + mCtl.TopIndex
                            If idx >= 0 Then mCtl.TopIndex = idx
                               Exit Function
                    End If
            Else
                    UnhookComboBoxScroll
            End If
    End If
    End  As Variant
    MouseProc = CallNextHookEx( _
                            mLngMouseHook, nCode, wParam, ByVal lParam)
    Exit Function
errH:
    UnhookComboBoxScroll
End Function
'''''''' end normal module code
 
End  As Variant
#End If

ошибка тут
Код
?
1
2
Sub HookComboBoxScroll(frm As Object, ctl As MSForms.Control)
 WindowFromPoint
Изменено: berlusconi - 02.12.2017 20:00:36
 
 
 
#2
24.11.2017 08:23:12
Замените части кодоа
Код
?
1
2
3
4
5
6
7
8
9
#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongPtrA" (ByVal hWnd As LongPtr, ByValnIndex As Long) As LongPtr
    #Else
        Private Declare PtrSafe Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
    #End If
#Else
    Private Declare Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
#End If
Код
?
1
Public Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpFn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
Код
?
1
Public Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Код
?
1
Public Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
Код
?
1
2
3
4
5
6
7
8
#If Win64 Then
        Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
                                                            ByVal Point As LongLong) As LongPtr    '
    #Else
        Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
                                                            ByVal xPoint As Long, _
                                                            ByVal yPoint As Long) As LongPtr    '
#End If
Изменено: Alemox - 24.11.2017 08:23:56
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.
 
 
 
#3
24.11.2017 18:35:32
Alemox  Добрый вечер!
Аналогичная ошибка
Код
?
1
2
Private Declare Function apiGetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Declare Function apiSetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Long
Изменено: Il'nar - 24.11.2017 18:37:01
 
 
 
#4
25.11.2017 16:27:53
Код
?
1
Private Declare PtrSafe Function apiGetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.
 
 
 
#5
25.11.2017 16:44:47
Alemox Спасибо большое!!! )
 
 
 
#6
02.12.2017 16:43:39
Цитата
Alemox написал: Замените части кодоа
Происходит та же ошибка, на другом компе работает отлично, разница только  в Office 2010 другой 2016 :cry:
 
 
 
#7
02.12.2017 16:46:40
прикрепите файл Excel со всем кодом
наверняка, декларации API функций всё же неверно написали (судя по первому сообщению в теме)
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#8
02.12.2017 17:53:10
Файл Excel сильно большой в текстовом файле код , как прописан в модуле
 
 
 
#9
02.12.2017 18:10:15
что это? зачем это?
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" _
                Alias "GetWindowLongA" (ByVal hWnd As LongLong, _
                                        ByVal nIndex As LongLong) As LongLong
    #Else
        Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" _
                Alias "GetWindowLongA" ( _
                ByVal hWnd As LongPtr, _
                ByVal nIndex As LongPtr) As LongPtr
    #End If
#ElseIf VBA6 Then
    Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" _
            Alias "GetWindowLongA" ( _
            ByVal hWnd As Long, _
            ByVal nIndex As Long) As Long
#End If


почему  PtrSafe везде?? он должен быть только для VBA7
пишите так:
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
#If VBA7 Then
    ' все функции внутри одного IF !!! а то код нечитаемый
    Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" _
            Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As LongPtr) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr
    ' ...
#Else
    Private Declare Function GetWindowLong Lib "user32.dll" _
            Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    ' ...
#End If


приведете код в нормальный вид, с учетом вышеописанного, - потом будем искать ошибку (если она останется)
Изменено: Игорь - 02.12.2017 18:11:55
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#10
16.12.2017 18:06:51
ошибка осталась, пробовал ещё на трёх компьютерах на работе с разными версиями Excel  , всё отлично работает, на одном не хочет :(

файл excel
 
 
 
#11
16.12.2017 18:49:10
Цитата
ошибка осталась
потому что вы не привели код в порядок
там фиг пойми что и как написано
я же вам написал, как правильно оформить декларирование функций
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#12
26.12.2017 23:38:33
уже исправил, ошибка та же.....
Рисунок удален: превышение допустимого размера вложения [МОДЕРАТОР]
 
 
 
#13
27.12.2017 21:52:04
berlusconi, для условия "#If VBA7" для типа "Long" нужно использовать "LongPtr", чтобы работало и в 32 и 64 разрядных. Потому что в 32-х разрядных нет типа данных "LongLong".
Для условия "#Else" для типа "Long" нужно писать "Long", т.к. в "Excel 2007-", нет типа данных "LongPtr".
Исправьте это и будет работать. Я исправил и у меня стало работать.

И структуры, если содержат специфический тип данных, тоже нужно помещать внутрь #If:
Скрытый текст
Изменено: Karataev - 27.12.2017 22:38:12
 
 
 
#14
28.12.2017 01:15:22
Цитата
Karataev написал:  Я исправил и у меня стало работать.
Спасибо за подсказку, уже исправил, но ничего не изменилось  :(
Изменено: berlusconi - 28.12.2017 01:35:45
 
 
 
#15
28.12.2017 09:28:06
Я сначала тестировал на 32-х разрядной - работает. На 64 не работает. Для данной ситуации нужно написать полностью один и тот же код и для условия #If VBA7 и для #Else.
То есть заключаете внутри #If VBA7 не только api-функции и структуры, но и процедуры "HookComboBoxScroll" и т.д. И то же самое делаете для #Else.
Это нужно, чтобы работало в 2003 - 2016. Если нужно, чтобы работало в 2010 - 2016, то проще - нужно у переменных и функций заменить тип данных из Long в LongPtr. В "2007-" нет LngPtr.
 
 
 
#16
30.12.2017 21:37:31
Цитата
Karataev написал:
Это нужно, чтобы работало в 2003 - 2016.
дело в том, что  только в 2016 не работает, во всех остальных версиях работает нормально
 
 
 
#17
30.12.2017 21:50:58
Какая разрядность у Вас в 2010, 2013 и 2016?
Изменено: Karataev - 30.12.2017 22:44:18
 
 
 
#18
30.12.2017 22:48:57
Цитата
Karataev написал:
Какая разрядность у Вас в 2010, 2013 и 2016?

на всех 64 в этом и непонятка .....
Изменено: berlusconi - 30.12.2017 22:50:31
 
 
 
#19
30.12.2017 22:58:13
Разрядность системы или офиса?
 
 
 
#20
30.12.2017 23:04:03
Цитата
Юрий М написал: Разрядность системы или офиса?
системы. на этом который не работает и система и офис 64
Изменено: berlusconi - 31.12.2017 01:55:05
 
 
 
#21
31.12.2017 07:54:03
Разрядность системы не имеет отношение к этой теме. Вам надо написать какая у Вас разрядность у 2010, 2013 и 2016.
 
 
 
#22
31.12.2017 14:22:05
Цитата
Игорь написал:
потому что вы не привели код в порядок
Используйте отступы нормально, а не копипаста без понимания из разных мест.
За Вас приходится заниматься чистописанием ибо читабельность никакая, а в чужом коде тем более.
Если Вы не хотите разбираться, то и работать само по себе ничего не будет.
Даже если за Вас сделали, то любое Ваше изменение и опять все равно придется разбираться, тем более, что MouseScroll капризная штука.
Всего лишь надо было отследить передачу переменных с учетом типа (не забываем про тип функций).
Сделал на скорую руку... Надеюсь ничего не проглядел...
Изменено: AAF - 31.12.2017 14:22:23
 
 
 
#23
31.12.2017 14:27:55
AAF, LongPtr нет в "Excel 2007-". А у Вас тип данных у переменных в процедурах "LongPtr".
 
 
 
#24
31.12.2017 14:31:21
Значит проглядел. Добавьте условие на VBA7, а то у меня Win64 только, и там напишите с использованием GetWindowLong
Код
?
1
2
3
4
5
6
7
8
9
#If VBA7 Then
  #If Win64 Then
    '
  #Else
    '
  #End If
#Else
  'сюда Long и использовать GetWindowLong
#End If
Изменено: AAF - 31.12.2017 14:38:24
 
 
 
#25
31.12.2017 14:35:41
Цитата
AAF написал:
сего лишь надо было отследить передачу переменных с учетом типа (не забываем про тип функций).
Сделал на скорую руку... Надеюсь ничего не проглядел...

спасибо большое, пытаюсь разобраться, сейчас ошибки нету, но и  MouseScroll не работает  :)
 
 
 
#26
31.12.2017 14:39:33
У меня MouseScroll работает.
Можете посмотреть еще вот такой вариант реализации.
Изменено: AAF - 31.12.2017 14:49:20
 
 
 
#27
31.12.2017 15:03:21
Цитата
AAF написал:
У меня MouseScroll работает.
задача сделать, чтобы один файл работал на любом компьютере, потому как на фирме много компьютеров с разным Office .....
 
 
 
#28
31.12.2017 15:07:52
Цитата
berlusconi написал:
много компьютеров с разным Office
Цитата
berlusconi написал:
MouseScroll не работает  
Тогда стоит указывать где работает, а где нет.
Вот, например, у меня нигде не осталось 2007 и я иногда забываю его учесть, но и проверить не могу. Но как правило рабочий код для таких офисов в интернете есть.
На 2013x32 работает и на 2016x64 работает
Место для кода 2007 офиса я сопроводил комментариями в сообщении 24
Изменено: AAF - 31.12.2017 15:12:26
 
 
 
#29
31.12.2017 15:14:21
berlusconi, в посте 21 Вам задан вопрос.
 
 
 
#30
31.12.2017 15:22:15
Цитата
AAF написал:
Тогда стоит указывать где работает, а где нет.

сейчас пробую на 2016 X64 не работает , но и не даёт ошибки, при закрытии файла перезагружается эксель  :cry:
 
 
 
Страницы: 1 2 След.
Читают тему
Наверх
Loading...