Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Не работает код макроса в 64 битной системе!
 
большое спасибо, сегодня проверил всё работает на 32 и 64 , вы по другому это всё реализовали, главное теперь для меня понять как это всё  работает  :)
Не работает код макроса в 64 битной системе!
 
Цитата
AAF написал:
Уже С новым годом!!!
Спасибо большое всем за помощь, всех с Наступающим Новым Годом !!!!! Всех благ!!! :)
Не работает код макроса в 64 битной системе!
 
Цитата
Karataev написал:
berlusconi, в посте 21 Вам задан вопрос.

сейчас не могу физически посмотреть, разрядность windows везде 64
Не работает код макроса в 64 битной системе!
 
Цитата
AAF написал:
Тогда стоит указывать где работает, а где нет.

сейчас пробую на 2016 X64 не работает , но и не даёт ошибки, при закрытии файла перезагружается эксель  :cry:
Не работает код макроса в 64 битной системе!
 
Цитата
AAF написал:
У меня MouseScroll работает.
задача сделать, чтобы один файл работал на любом компьютере, потому как на фирме много компьютеров с разным Office .....
Не работает код макроса в 64 битной системе!
 
Цитата
AAF написал:
сего лишь надо было отследить передачу переменных с учетом типа (не забываем про тип функций).
Сделал на скорую руку... Надеюсь ничего не проглядел...

спасибо большое, пытаюсь разобраться, сейчас ошибки нету, но и  MouseScroll не работает  :)
Не работает код макроса в 64 битной системе!
 
Цитата
Юрий М написал: Разрядность системы или офиса?
системы. на этом который не работает и система и офис 64
Изменено: berlusconi - 31.12.2017 01:55:05
Не работает код макроса в 64 битной системе!
 
Цитата
Karataev написал:
Какая разрядность у Вас в 2010, 2013 и 2016?

на всех 64 в этом и непонятка .....
Изменено: berlusconi - 30.12.2017 22:50:31
Не работает код макроса в 64 битной системе!
 
Цитата
Karataev написал:
Это нужно, чтобы работало в 2003 - 2016.
дело в том, что  только в 2016 не работает, во всех остальных версиях работает нормально
Не работает код макроса в 64 битной системе!
 
Цитата
Karataev написал:  Я исправил и у меня стало работать.
Спасибо за подсказку, уже исправил, но ничего не изменилось  :(
Изменено: berlusconi - 28.12.2017 01:35:45
Не работает код макроса в 64 битной системе!
 
уже исправил, ошибка та же.....
Рисунок удален: превышение допустимого размера вложения [МОДЕРАТОР]
Не работает код макроса в 64 битной системе!
 
ошибка осталась, пробовал ещё на трёх компьютерах на работе с разными версиями Excel  , всё отлично работает, на одном не хочет :(

файл excel
Не работает код макроса в 64 битной системе!
 
Файл Excel сильно большой в текстовом файле код , как прописан в модуле
Не работает код макроса в 64 битной системе!
 
Цитата
Alemox написал: Замените части кодоа
Происходит та же ошибка, на другом компе работает отлично, разница только  в Office 2010 другой 2016 :cry:
Не работает код макроса в 64 битной системе!
 
Помогите разобраться, есть два компьютера оба 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

ошибка тут
Код
Sub HookComboBoxScroll(frm As Object, ctl As MSForms.Control)
 WindowFromPoint
Изменено: berlusconi - 02.12.2017 20:00:36
Не работает код макроса в 64 битной системе!
 
Помогите разобраться, есть два компьютера оба 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
подсветка одинаковых ячеек
 
Спасибо большое, разобрался уже  :)
подсветка одинаковых ячеек
 
:D  
а,что обозначает буква "к" в этой формуле =A1=к?
подсветка одинаковых ячеек
 
:) ну хорошо постараюсь....спасибо ещё раз!
подсветка одинаковых ячеек
 
:D честно говоря ничего не понял, я не програмист....  :(
подсветка одинаковых ячеек
 
Спасибо, суть такая же  :)
а как это сделать?
подсветка одинаковых ячеек
 
Цитата
ikki пишет:
а теперь оно спряталось?
нет не спряталось, я года два назад был в одном НИИ, там была какая то презентация, не помню уже, человек открывал файлы Excel, что бы показать данные и происходило, то что я описал выше...
Изменено: berlusconi - 16.03.2013 17:06:38
подсветка одинаковых ячеек
 
Доброго времени суток, задача такая, есть лист на котором много цифровых значений в ячейках, как сделать так чтобы при наведении курсора на ячейку она подсвечивалась, а также подсвечивались все ячейки с такими же числами, я уже видел такое решение, но давно уже, да ине узнал как сделать.Спасибо  :)
Страницы: 1
Loading...