Страницы: 1
RSS
Не работает код макроса в 64 битной системе!
 
Подскажите, пожалуйста, как поменять код ниже, чтобы он работал и на 32, и на 64 битах.:
Код
Private Declare Function GetSystemMenu Lib "user32" _ 
(ByVal hwnd As Long, ByVal bRevert As Long) As Long
Изменено: Punker - 21.11.2016 19:54:14
 
Вот вопрос-то - 32 Or 64 - чего?! Система аль XL? Иль И то, и другое?
ps Обычно на 64 системе офис 32 используют. А у вас?
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
У обоих 64.
 
На Google забанили?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Код
#If Win64 Then
  ' Игнорируйте то, что отладчик выделяет цветом 5 строк ниже, это декларации для 64-битной версии
  Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
  Declare PtrSafe Function GetCursorPos Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) As Long
  Declare PtrSafe Function SetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hWnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  Declare PtrSafe Function GetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
  Declare PtrSafe Function GetSystemMetrics Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
  ' Строка ниже используется только для вызова в коде формы
  Declare PtrSafe Function GetForegroundWindow Lib "user32" Alias "GetForegroundWindow" () As LongPtr
#Else
  Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  Private Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long
  Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
  Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
  ' Строка ниже используется только для вызова в коде формы
  Declare Function GetForegroundWindow Lib "user32" () As Long
#End If
Живи и дай жить..
 
The_Prist, нет не забанили, но поиском я не нашёл.

Слэн, я правильно понял что код для моей строки:
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
должен выглядеть так:
Declare PtrSafe Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As LongPtr
А то у меня ругается.
 
объясняем..
если win64, то внешние функции объявляются одним образом, иначе другим
как, смотрите по аналогии
и запись
#if win64 then
..
#else
..
#endif

как раз и обеспечивает работу и там и там.
Изменено: Слэн - 11.11.2013 19:27:50
Живи и дай жить..
 
Для 64 скорее будет
Declare PtrSafe Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As LongPtr, ByVal bRevert As Long) As LongPtr
hwnd это же handle, а он в 64бит системе тоже 64
 
а почему не

Код
Private Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hwnd As LongPtr, ByVal bRevert As Long) As LongPtr


или

Код
Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hwnd As LongPtr, ByVal bRevert As Long) As LongPtr


кстати - у меня 32 бита не ругается на  PtrSafe. Следовательно IF использовать нет надобности.
Изменено: Dima S - 11.11.2013 17:24:47
 
Цитата
Dima S пишет:
кстати - у меня 32 бита не ругается наPtrSafe
Если VBA7 - то и не будет...
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Я сделал так, ругается на findwindow:
Код
#If Win64 Then
    Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hwnd As LongPtr, ByVal bRevert As LongPtr) As LongPtr
    Declare PtrSafe Function RemoveMenu Lib "user32" (ByVal hMenu As LongPtr, ByVal nPosition As LongPtr, ByVal wFlags As LongPtr) As LongPtr
    Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
    Public Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
    Public Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
    Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If
 
Сделайте так:
Код
#If Win64 Then
  Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hwnd As LongPtr, ByVal bRevert As Long) As LongPtr
  Declare PtrSafe Function RemoveMenu Lib "user32" (ByVal hMenu As LongPtr, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
  Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
  Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If
Вместо #If Win64 Then можно записать #If VBA7 Then

Если в коде возникнут ошибки, то проблема в типе переменных, которые используются при вызове API-функций. Тогда нужно также с помощью #If - #Else - #End If объявлять эти переменные с разными типами для 32 и 64 битных версий Excel.
Но можно и проще - объявить такие переменные как As Variant.
Изменено: ZVI - 21.11.2016 00:15:37
 
Спасибо всем за помощь.
Да, Владимир, дело оказалось в объявлении переменной, поменял на Variant и ошибка ушла. Спасибо огромное.
Изменено: Punker - 12.11.2013 14:47:33
 
> Punker: ... ошибка ушла.

И пусть больше не приходит  :)
Рад, что помогло, Алексей
Изменено: ZVI - 12.11.2013 17:02:07
 
Код
подскажите а куда вставлять этот код2
#If Win64 Then
  Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hwnd As LongPtr, ByVal bRevert As Long) As LongPtr 
  Declare PtrSafe Function RemoveMenu Lib "user32" (ByVal hMenu As LongPtr, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else 
  Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long 
  Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 
#End If
Изменено: juk2000 - 21.11.2016 23:40:55
 
juk2000, код следует оформлять соответствующим тегом. Ищите кнопку <...> и исправьте своё сообщение.
Спасибо!
 
Цитата
juk2000 написал: куда вставлять этот код
Код нужно вставлять в начало стандартного модуля, после строчки Option Explicit, если такая строчка есть.
Пошаговая иструкция:
1. Нажать Alt-F11, чтобы попасть в редактор кода VBE
2. Меню Insert - Module. Будет добален стандартный модуль для кода.
3. В созданном окно в текущую позицию записать код:
Код
#If Win64 Then
  Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hwnd As LongPtr, ByVal bRevert As Long) As LongPtr
  Declare PtrSafe Function RemoveMenu Lib "user32" (ByVal hMenu As LongPtr, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
  Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
  Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If

Только вот что Вы дальше будете делать с кодом - мне неизвестно.
Используйте как пример декларирования API-функций, которые должны работать как  в 32, так и в 64-битном Excel.
Изменено: ZVI - 20.11.2016 23:58:52
 
Помогите разобраться, есть два компьютера оба 64-bit , на одном компьютере работает без проблем , на другом выдает ошибку


'''''' 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
Читают тему
Наверх