Risultati da 1 a 21 di 21

Discussione: Rotella del mouse in una combobox, varie versioni Excel



  1. #1
    L'avatar di cinziorecoaro
    Clicca e Apri
    Data Registrazione
    Apr 2016
    LocalitÓ
    Recoaro Terme (VI)
    EtÓ
    37
    Messaggi
    34
    Versione Office
    2003+2010+2016
    Likes ricevuti
    3
    Likes dati
    4

    Rotella del mouse in una combobox, varie versioni Excel

    Buongiorno,

    ho in azienda un file .xls che contiene una combobox ove i dati possono venir scorsi con la rotellina del mouse. Tutto funziona perfettamente su macchine con Windows Xp ed Office 2003, Win7 64bit ed Office2003, Win10 64bit ed Office2016.

    Il problema si presenta quando cerchiamo di aprire la combobox su dei computer con Windows 7 64bit ed Office 2010: quando l'utente fa un doppio click sul foglio compare l'errore all'interno di questa routine:

    Codice: 
    Private Sub Hook_Mouse()
    
    
        If lLowLevelMouse = 0 Then
            lLowLevelMouse = SetWindowsHookEx _
            (WH_MOUSE_LL, AddressOf LowLevelMouseProc, GetAppInstance, 0)
        End If
        
    End Sub
    Viene evidenziata la voce AddressOf LowLevelMouseProc

    Ecco il modulo colmpleto:

    Codice: 
    Option Explicit
    
    
    Private Type POINTAPI
      x As Long
      y As Long
    End Type
    
    
    Private Type MSLLHOOKSTRUCT
        pt As POINTAPI
        mousedata As Long
        flags As Long
        time As Long
        dwExtraInfo As Long
    End Type
    
    
    #If VBA7 Then
        Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
        Alias "RtlMoveMemory" _
        (ByVal Destination As Long, _
        ByVal Source As Long, _
        ByVal Length As Long)
    #Else
        Private Declare Sub CopyMemory Lib "kernel32" _
        Alias "RtlMoveMemory" _
        (ByVal Destination As Long, _
        ByVal Source As Long, _
        ByVal Length As Long)
    #End If
    
    
    
    
    #If VBA7 And Win64 Then
        Private Declare PtrSafe Function FindWindow Lib "user32.dll" _
        Alias "FindWindowA" _
        (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
    #Else
        Private Declare Function FindWindow Lib "user32.dll" _
        Alias "FindWindowA" _
        (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
    #End If
    
    
    #If VBA7 Then
        Private Declare PtrSafe Function GetWindowLong Lib "user32" _
        Alias "GetWindowLongA" ( _
        ByVal hwnd As Long, _
        ByVal nIndex As Long) As Long
    #Else
        Private Declare Function GetWindowLong Lib "user32" _
        Alias "GetWindowLongA" ( _
        ByVal hwnd As Long, _
        ByVal nIndex As Long) As Long
    #End If
    
    
    #If VBA7 Then
        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 Long
    #Else
        Private Declare Function SetWindowsHookEx Lib _
        "user32" _
        Alias "SetWindowsHookExA" _
        (ByVal idHook As Long, _
        ByVal lpfn As Long, _
        ByVal hmod As Long, _
        ByVal dwThreadId As Long) As Long
    #End If
    
    
    #If VBA7 Then
        Private Declare PtrSafe Function CallNextHookEx Lib "user32" _
        (ByVal hHook As Long, _
        ByVal nCode As Long, _
        ByVal wParam As Long, _
        lParam As Any) As Long
    #Else
        Private Declare Function CallNextHookEx Lib "user32" _
        (ByVal hHook As Long, _
        ByVal nCode As Long, _
        ByVal wParam As Long, _
        lParam As Any) As Long
    #End If
    
    
    #If VBA7 Then
        Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" _
        (ByVal hHook As Long) As Long
    #Else
        Private Declare Function UnhookWindowsHookEx Lib "user32" _
        (ByVal hHook As Long) As Long
    #End If
    
    
    Private Const HC_ACTION = 0
    Private Const WH_MOUSE_LL = 14
    Private Const WM_MOUSEWHEEL = &H20A
    Private Const GWL_HINSTANCE = (-6)
    
    
    Private uParamStruct As MSLLHOOKSTRUCT
    Private oObject As Object
    Private lLowLevelMouse As Long
    Private bHooked As Boolean
    
    
    '====================='
    '\\ Public Routines   '
    '====================='
    
    
    Public Property Let MakeScrollableWithMouseWheel _
    (ByVal Obj As Object, ByVal vNewValue As Boolean)
    
    
        If vNewValue Then
            Hook_Mouse
        Else
            UnHook_Mouse
        End If
        
        Set oObject = Obj
        bHooked = vNewValue
    
    
    End Property
    
    
    
    
    Public Property Get MakeScrollableWithMouseWheel _
    (ByVal Obj As Object) As Boolean
    
    
        MakeScrollableWithMouseWheel = bHooked
    
    
    End Property
    
    
    
    
    
    
    '====================='
    '\\ Private Routines  '
    '====================='
    #If VBA7 Then
    Function LowLevelMouseProc _
    (ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPtr
        
        Static iTopIndex As Integer
        
        On Error Resume Next
        
        If (nCode = HC_ACTION) Then
            If wParam = WM_MOUSEWHEEL Then
                With oObject
                    If GetHookStruct(lParam).mousedata > 0 Then
                        .TopIndex = iTopIndex - 1
                        iTopIndex = .TopIndex
                    Else
                        .TopIndex = iTopIndex + 1
                        iTopIndex = .TopIndex
                    End If
                End With
                LowLevelMouseProc = -1
                Exit Function
            End If
        End If
    
    
        LowLevelMouseProc = _
        CallNextHookEx(lLowLevelMouse, nCode, wParam, ByVal lParam)
    #Else
    Function LowLevelMouseProc _
    (ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
    
        Static iTopIndex As Integer
     
        On Error Resume Next
        
        If (nCode = HC_ACTION) Then
            If wParam = WM_MOUSEWHEEL Then
                With oObject
                    If GetHookStruct(lParam).mousedata > 0 Then
                        .TopIndex = iTopIndex - 1
                        iTopIndex = .TopIndex
                    Else
                        .TopIndex = iTopIndex + 1
                        iTopIndex = .TopIndex
                    End If
                End With
                LowLevelMouseProc = -1
                Exit Function
            End If
        End If
    
    
        LowLevelMouseProc = _
        CallNextHookEx(lLowLevelMouse, nCode, wParam, ByVal lParam)
    #End If
    End Function
    
    
    
    
    
    
    Private Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT
    
    
       CopyMemory VarPtr(uParamStruct), lParam, LenB(uParamStruct)
       GetHookStruct = uParamStruct
        
    End Function
    
    
    Private Function GetAppInstance() As Long
     
        GetAppInstance = GetWindowLong _
        (FindWindow("XLMAIN", Application.Caption), GWL_HINSTANCE)
     
    End Function
    
    
    Private Sub Hook_Mouse()
    
    
        If lLowLevelMouse = 0 Then
            lLowLevelMouse = SetWindowsHookEx _
            (WH_MOUSE_LL, AddressOf LowLevelMouseProc, GetAppInstance, 0)
        End If
        
    End Sub
    
    
    Private Sub UnHook_Mouse()
        
        If lLowLevelMouse <> 0 Then _
        UnhookWindowsHookEx lLowLevelMouse: lLowLevelMouse = 0
        
    End Sub

    Sapete aiutarmi per favore?

  2. #2
    L'avatar di zio_tom
    Clicca e Apri
    Data Registrazione
    Oct 2015
    LocalitÓ
    Veneto
    Messaggi
    525
    Versione Office
    2010 - Win10
    Likes ricevuti
    63
    Likes dati
    17

    Re: Rotella del mouse in una combobox, varie versioni Excel

    se posti un file con le routine e combobox implementate diventa tutto pi˙ semplice per tutti
    cosÝ vediamo come Ú implementato e come viene richiamata
    una versione che funzioni sulle configurazioni menzionate
    grazie


    PS: a memoria ricordi di aver trovato codice per usare la rotellina nelle combobox, ma mi sembrava, a memoria, molto pi˙ semplice
    forse c'Ú qualcosa anche qui nel forum

  3. #3
    L'avatar di cinziorecoaro
    Clicca e Apri
    Data Registrazione
    Apr 2016
    LocalitÓ
    Recoaro Terme (VI)
    EtÓ
    37
    Messaggi
    34
    Versione Office
    2003+2010+2016
    Likes ricevuti
    3
    Likes dati
    4

    Re: Rotella del mouse in una combobox, varie versioni Excel

    Ecco piccole modifiche:

    Il foglio della combobox

    Codice: 
    Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
    
    
    Dim str As String
    Dim cboTemp As OLEObject
    Dim WS As Worksheet
    Dim parola As String
    Set WS = ActiveSheet
    parola = "INDIRETTO"
    
    
    Set cboTemp = WS.OLEObjects("TempCombo")
    cboTemp.Activate
    cboTemp.Visible = True
      On Error Resume Next
      With cboTemp
      'clear and hide the combo box
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
      End With
    On Error GoTo errHandler
      If target.Validation.Type = 3 Then
        'MsgBox ("si parte")
        'if the cell contains
          'a data validation list
        Cancel = True
        Application.EnableEvents = True
        'get the data validation formula
        str = target.Validation.Formula1
        str = Right(str, Len(str) - 1)
        'MsgBox (str)
        If InStr(str, parola) = 0 Then GoTo noindi
            'MsgBox ("trovato")
            str = Replace(str, "INDIRETTO(", "")     'Remove INDIRECT and opening parenthesis
            str = Left(str, Len(str) - 1)           'Remove last closing parenthesis
            'MsgBox (str)
            str = Evaluate(str)                     'Evaluate the formula to return named range
        End If
    noindi:
        With cboTemp
          'show the combobox with the list
          .Visible = True
          .Left = target.Left
          .Top = target.Top
          .Width = target.Width + 5
          .Height = target.Height + 5
          .ListFillRange = str
          .LinkedCell = target.Address
        End With
        cboTemp.Activate
        'open the drop down list automatically
        Me.TempCombo.DropDown
        MakeScrollableWithMouseWheel(TempCombo) = True
      'End If
    'MsgBox ("target.adress " & Target.Address)
    'If Target.Address = "$B$4" Or Target.Address = "$b$5" Then Call data
    '    If Target.Value <> "IMMEDIATA" And Target.Value <> "URGENTE" Then
    '        Target.Value = CDbl(Target.Value)
     '       Target.Range(Target.Address).NumberFormat = "dd/mm/yyyy"
      '  End If
    'End If
    'Call data
    
    
    errHandler:
      Application.EnableEvents = True
      Exit Sub
    
    
    End Sub
    '=========================================
    Private Sub TempCOmbo_LostFocus()
    MakeScrollableWithMouseWheel(TempCombo) = False
      With Me.TempCombo
        .Top = 10
        .Left = 10
        .Width = 0
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
        .Value = ""
      End With
    End Sub
     
    '====================================
    'Optional code to move to next cell
    'if Tab or Enter are pressed
    'from code by Ted Lanham
    '***NOTE: if KeyDown causes problems,
    'change to KeyUp
    'Table with numbers for other keys
    'such as Right Arrow (39)
    'https://msdn.microsoft.com/en-us/library/aa243025%28v=vs.60%29.aspx
    'For dates or numbers in the data validation, you can use the KeyDown code in the Code for Numbers section below.
    
    
    Private Sub TempCombo_KeyDown(ByVal _
         KeyCode As MSForms.ReturnInteger, _
         ByVal Shift As Integer)
      Select Case KeyCode
        Case 9 'Tab
          ActiveCell.Offset(0, 1).Activate
        Case 13 'Enter
          ActiveCell.Offset(1, 0).Activate
        Case Else
            'do nothing
      End Select
    End Sub
    '====================================
    'Private WithEvents wb As Workbook
    
    
    'Private Sub ComboBox1_GotFocus()
      '  Set wb = ThisWorkbook
      ' MakeScrollableWithMouseWheel(TempCombo) = True
    'End Sub
    
    
    'Private Sub ComboBox1_LostFocus()
    '    MakeScrollableWithMouseWheel(TempCombo) = False
    'End Sub
    
    
    
    
    'Private Sub wb_BeforeClose(Cancel As Boolean)
      '  If MakeScrollableWithMouseWheel(TempCombo) Then
        '    MakeScrollableWithMouseWheel(TempCombo) = False
      '  End If
    'End Sub
    il modulo31
    Codice: 
    Option Explicit
    
    
    Private Type POINTAPI
      x As Long
      y As Long
    End Type
    
    
    Private Type MSLLHOOKSTRUCT
        pt As POINTAPI
        mousedata As Long
        flags As Long
        time As Long
        dwExtraInfo As Long
    End Type
    
    
    #If VBA7 Then
        Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
        Alias "RtlMoveMemory" _
        (ByVal Destination As LongPtr, _
        ByVal Source As LongPtr, _
        ByVal Length As LongPtr)
        
        Private Declare PtrSafe Function FindWindow Lib "user32.dll" _
        Alias "FindWindowA" _
        (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As LongPtr
        
        Private Declare PtrSafe Function GetWindowLong Lib "user32" _
        Alias "GetWindowLongA" ( _
        ByVal hwnd As LongPtr, _
        ByVal nIndex As LongPtr) As LongPtr
        
        Private Declare PtrSafe Function SetWindowsHookEx Lib _
        "user32" _
        Alias "SetWindowsHookExA" _
        (ByVal idHook As LongPtr, _
        ByVal lpfn As LongPtr, _
        ByVal hmod As LongPtr, _
        ByVal dwThreadId As LongPtr) As LongPtr
        
        Private Declare PtrSafe Function CallNextHookEx Lib "user32" _
        (ByVal hHook As LongPtr, _
        ByVal nCode As LongPtr, _
        ByVal wParam As LongPtr, _
        lParam As Any) As LongPtr
        
        Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" _
        (ByVal hHook As LongPtr) As LongPtr
    #Else
        Private Declare Sub CopyMemory Lib "kernel32" _
        Alias "RtlMoveMemory" _
        (ByVal Destination As Long, _
        ByVal Source As Long, _
        ByVal Length As Long)
        
        Private Declare Function FindWindow Lib "user32.dll" _
        Alias "FindWindowA" _
        (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
        
        Private Declare Function GetWindowLong Lib "user32" _
        Alias "GetWindowLongA" ( _
        ByVal hwnd As Long, _
        ByVal nIndex As Long) As Long
        
        Private Declare Function SetWindowsHookEx Lib _
        "user32" _
        Alias "SetWindowsHookExA" _
        (ByVal idHook As Long, _
        ByVal lpfn As Long, _
        ByVal hmod As Long, _
        ByVal dwThreadId As Long) As Long
        
        Private Declare Function CallNextHookEx Lib "user32" _
        (ByVal hHook As Long, _
        ByVal nCode As Long, _
        ByVal wParam As Long, _
        lParam As Any) As Long
        
        Private Declare Function UnhookWindowsHookEx Lib "user32" _
        (ByVal hHook As Long) As Long
    #End If
    
    
    
    
    Private Const HC_ACTION = 0
    Private Const WH_MOUSE_LL = 14
    Private Const WM_MOUSEWHEEL = &H20A
    Private Const GWL_HINSTANCE = (-6)
    
    
    Private uParamStruct As MSLLHOOKSTRUCT
    Private oObject As Object
    Private lLowLevelMouse As Long
    Private bHooked As Boolean
    
    
    '====================='
    '\\ Public Routines   '
    '====================='
    
    
    Public Property Let MakeScrollableWithMouseWheel _
    (ByVal Obj As Object, ByVal vNewValue As Boolean)
    
    
        If vNewValue Then
            Hook_Mouse
        Else
            UnHook_Mouse
        End If
        
        Set oObject = Obj
        bHooked = vNewValue
    
    
    End Property
    
    
    
    
    Public Property Get MakeScrollableWithMouseWheel _
    (ByVal Obj As Object) As Boolean
    
    
        MakeScrollableWithMouseWheel = bHooked
    
    
    End Property
    
    
    
    
    
    
    '====================='
    '\\ Private Routines  '
    '====================='
    #If VBA7 Then
        Function LowLevelMouseProc _
        (ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        
            Static iTopIndex As Integer
            
            On Error Resume Next
            
            If (nCode = HC_ACTION) Then
                If wParam = WM_MOUSEWHEEL Then
                    With oObject
                        If GetHookStruct(lParam).mousedata > 0 Then
                            .TopIndex = iTopIndex - 1
                            iTopIndex = .TopIndex
                        Else
                            .TopIndex = iTopIndex + 1
                            iTopIndex = .TopIndex
                        End If
                    End With
                    LowLevelMouseProc = -1
                    Exit Function
                End If
            End If
        
            LowLevelMouseProc = _
            CallNextHookEx(lLowLevelMouse, nCode, wParam, ByVal lParam)
    #Else
     Function LowLevelMouseProc _
        (ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        
            Static iTopIndex As Integer
            
            On Error Resume Next
            
            If (nCode = HC_ACTION) Then
                If wParam = WM_MOUSEWHEEL Then
                    With oObject
                        If GetHookStruct(lParam).mousedata > 0 Then
                            .TopIndex = iTopIndex - 1
                            iTopIndex = .TopIndex
                        Else
                            .TopIndex = iTopIndex + 1
                            iTopIndex = .TopIndex
                        End If
                    End With
                    LowLevelMouseProc = -1
                    Exit Function
                End If
            End If
        
            LowLevelMouseProc = _
            CallNextHookEx(lLowLevelMouse, nCode, wParam, ByVal lParam)
    #End If
    End Function
    
    
    Private Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT
    
    
       CopyMemory VarPtr(uParamStruct), lParam, LenB(uParamStruct)
       GetHookStruct = uParamStruct
        
    End Function
    
    
    Private Function GetAppInstance() As Long
     
        GetAppInstance = GetWindowLong _
        (FindWindow("XLMAIN", Application.Caption), GWL_HINSTANCE)
     
    End Function
    
    
    Private Sub Hook_Mouse()
    
    
        If lLowLevelMouse = 0 Then
            lLowLevelMouse = SetWindowsHookEx _
            (WH_MOUSE_LL, AddressOf LowLevelMouseProc, GetAppInstance, 0)
        End If
        
    End Sub
    
    
    Private Sub UnHook_Mouse()
        
        If lLowLevelMouse <> 0 Then _
        UnhookWindowsHookEx lLowLevelMouse: lLowLevelMouse = 0
        
    End Sub
    File Allegati File Allegati

  4. #4

    L'avatar di alfrimpa
    Clicca e Apri
    Data Registrazione
    Dec 2015
    LocalitÓ
    Napoli
    EtÓ
    64
    Messaggi
    6749
    Versione Office
    2013
    Likes ricevuti
    711
    Likes dati
    162

    Re: Rotella del mouse in una combobox, varie versioni Excel

    Ho aperto il file ed a me sembra comportarsi correttamente; con la rotellina del mouse scorro la combo.

    Ho Win7 32 bit ed Excel 2007.

    Alfredo

  5. #5
    L'avatar di cinziorecoaro
    Clicca e Apri
    Data Registrazione
    Apr 2016
    LocalitÓ
    Recoaro Terme (VI)
    EtÓ
    37
    Messaggi
    34
    Versione Office
    2003+2010+2016
    Likes ricevuti
    3
    Likes dati
    4

    Re: Rotella del mouse in una combobox, varie versioni Excel

    eh il problema si presenta ugualmente su pi¨ computer con Windows 7 64bit ed Excel 2010 32bit. Invece su questo Windows 10 64bit ed Excel 2016 32bit funziona perfettamente

  6. #6
    L'avatar di zio_tom
    Clicca e Apri
    Data Registrazione
    Oct 2015
    LocalitÓ
    Veneto
    Messaggi
    525
    Versione Office
    2010 - Win10
    Likes ricevuti
    63
    Likes dati
    17

    Re: Rotella del mouse in una combobox, varie versioni Excel

    a me appena apro il file da errore su: 'questa cartella di lavoro'

    stofoglio.Activate

    Codice: 
    Sub workbook_open()
    Dim stacarte As Workbook
    Dim stofoglio As Worksheet
    Set stacarte = ThisWorkbook
    Set stofoglio = stacarte.Sheets(1)
    stofoglio.Activate
    Range("a1").Activate
    Range("b2").Activate
    Range("d11") = "by Massimo Griffani 04/2016"
       
    For i = 2 To Application.ActiveWorkbook.Sheets.Count
        ActiveWorkbook.Sheets(i).Visible = False
    Next
    End Sub
    e non vedo nessun ComboBox
    e nemmeno cartelle di Form
    vedo 'Convalida dati' da Elenco NON ComboBox
    e dentro elenco convalida dati la rotella non funzione
    sto provando con Excel2010 ed XP

    una volta superato l'errore iniziale
    come si dovrebbe procedere??? tanto per essere sicuri

  7. #7

    L'avatar di alfrimpa
    Clicca e Apri
    Data Registrazione
    Dec 2015
    LocalitÓ
    Napoli
    EtÓ
    64
    Messaggi
    6749
    Versione Office
    2013
    Likes ricevuti
    711
    Likes dati
    162

    Re: Rotella del mouse in una combobox, varie versioni Excel

    Ciao zio_tom

    A parte l'errore che rilevi, per far comparire la combo devi fare doppio clic su B6/B7 del foglio Crea Ordine

    Alfredo

  8. #8
    L'avatar di cinziorecoaro
    Clicca e Apri
    Data Registrazione
    Apr 2016
    LocalitÓ
    Recoaro Terme (VI)
    EtÓ
    37
    Messaggi
    34
    Versione Office
    2003+2010+2016
    Likes ricevuti
    3
    Likes dati
    4

    Re: Rotella del mouse in una combobox, varie versioni Excel

    Beh le istruzioni di workbook_open sono totalmente inutili al nostro scopo ed anche inutilmente lunga. La combo invece box Ŕ nascosta, compare solo se si fa un doppio click sulle colonna B alla riga "Fornitore" od "articolo". Nelle piattaforme dove compare tutto sembra funzionare, altrimenti si cade nell'errore di cui sopra.


    Inviato dal mio iPad utilizzando Tapatalk

  9. #9
    L'avatar di zio_tom
    Clicca e Apri
    Data Registrazione
    Oct 2015
    LocalitÓ
    Veneto
    Messaggi
    525
    Versione Office
    2010 - Win10
    Likes ricevuti
    63
    Likes dati
    17

    Re: Rotella del mouse in una combobox, varie versioni Excel

    Quella con doppio click su Fornitori per me un 'Convalida Dati' da Elenco NON ComboBox
    se cado su cella fornitori e poi apro convalida dati vedo da Elenco e punta su =FORNITORI
    se entro con doppioclick la rotella fiunziona invece se per aprire uso freccia a destra non funziona

    in oltre alcune volte uscendo Excel mi va in crash

  10. #10
    L'avatar di cinziorecoaro
    Clicca e Apri
    Data Registrazione
    Apr 2016
    LocalitÓ
    Recoaro Terme (VI)
    EtÓ
    37
    Messaggi
    34
    Versione Office
    2003+2010+2016
    Likes ricevuti
    3
    Likes dati
    4

    Re: Rotella del mouse in una combobox, varie versioni Excel

    In definitiva abbandoner˛ il progetto rotella e toglier˛ tutte quelle chiamate api ed amen mi sa


    Inviato dal mio iPhone utilizzando Tapatalk

  11. #11
    L'avatar di cinziorecoaro
    Clicca e Apri
    Data Registrazione
    Apr 2016
    LocalitÓ
    Recoaro Terme (VI)
    EtÓ
    37
    Messaggi
    34
    Versione Office
    2003+2010+2016
    Likes ricevuti
    3
    Likes dati
    4

    Re: Rotella del mouse in una combobox, varie versioni Excel

    Ho risolto impostando function per function If vba 7 dichiara LongPtr altrimenti Long. A forza di tentativi missione compiuta!

  12. #12
    L'avatar di zio_tom
    Clicca e Apri
    Data Registrazione
    Oct 2015
    LocalitÓ
    Veneto
    Messaggi
    525
    Versione Office
    2010 - Win10
    Likes ricevuti
    63
    Likes dati
    17

    Re: Rotella del mouse in una combobox, varie versioni Excel

    ma il codice postato Ú giß cosÝ
    non no capito come l'hai modificato

    If VBA7 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" _
    (ByVal Destination As LongPtr, _
    ByVal Source As LongPtr, _
    ByVal Length As LongPtr)

    ......

  13. #13
    L'avatar di cinziorecoaro
    Clicca e Apri
    Data Registrazione
    Apr 2016
    LocalitÓ
    Recoaro Terme (VI)
    EtÓ
    37
    Messaggi
    34
    Versione Office
    2003+2010+2016
    Likes ricevuti
    3
    Likes dati
    4

    Re: Rotella del mouse in una combobox, varie versioni Excel

    Domani controller˛


    Inviato dal mio iPhone utilizzando Tapatalk

  14. #14

    L'avatar di alfrimpa
    Clicca e Apri
    Data Registrazione
    Dec 2015
    LocalitÓ
    Napoli
    EtÓ
    64
    Messaggi
    6749
    Versione Office
    2013
    Likes ricevuti
    711
    Likes dati
    162

    Re: Rotella del mouse in una combobox, varie versioni Excel

    Ciao Cinzio

    Ti allego file che ho scaricato tempo fa da internet.

    Non so se a te funzionerÓ e se riesci ad adattarlo al tuo caso

    Alfredo
    File Allegati File Allegati

  15. #15
    L'avatar di cinziorecoaro
    Clicca e Apri
    Data Registrazione
    Apr 2016
    LocalitÓ
    Recoaro Terme (VI)
    EtÓ
    37
    Messaggi
    34
    Versione Office
    2003+2010+2016
    Likes ricevuti
    3
    Likes dati
    4

    Re: Rotella del mouse in una combobox, varie versioni Excel

    Ciao a tutti. Ecco la soluzione che dicevo ieri
    Codice: 
    Option Explicit
    
    
    Private Type POINTAPI
      x As Long
      y As Long
    End Type
    
    
    Private Type MSLLHOOKSTRUCT
        pt As POINTAPI
        mousedata As Long
        flags As Long
        time As Long
        dwExtraInfo As Long
    End Type
    
    
    #If VBA7 Then
        #If Win64 Then
            Private Declare PtrSafe Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex 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
    
    
    #If VBA7 Then
        Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
        Alias "RtlMoveMemory" _
        (ByVal Destination As LongPtr, _
        ByVal Source As LongPtr, _
        ByVal Length As LongPtr)
        
        Private Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
        
        Private 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
        
      
        Private Declare PtrSafe Function CallNextHookEx Lib "USER32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
        
        Private Declare PtrSafe Function UnhookWindowsHookEx Lib "USER32" (ByVal hhk As LongPtr) As Long
    #Else
        Private Declare Sub CopyMemory Lib "kernel32" _
        Alias "RtlMoveMemory" _
        (ByVal Destination As Long, _
        ByVal Source As Long, _
        ByVal Length As Long)
        
        Private Declare Function FindWindow Lib "user32.dll" _
        Alias "FindWindowA" _
        (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
        
        Private Declare Function SetWindowsHookEx Lib _
        "USER32" _
        Alias "SetWindowsHookExA" _
        (ByVal idHook As Long, _
        ByVal lpfn As Long, _
        ByVal hmod As Long, _
        ByVal dwThreadId As Long) As Long
        
        Private Declare Function CallNextHookEx Lib "USER32" _
        (ByVal hHook As Long, _
        ByVal ncode As Long, _
        ByVal wParam As Long, _
        lParam As Any) As Long
        
        Private Declare Function UnhookWindowsHookEx Lib "USER32" _
        (ByVal hHook As Long) As Long
    #End If
    
    
    
    
    Private Const HC_ACTION = 0
    Private Const WH_MOUSE_LL = 14
    Private Const WM_MOUSEWHEEL = &H20A
    Private Const GWL_HINSTANCE = (-6)
    
    
    #If VBA7 Then
        Private hHook As LongPtr
    #Else
        Private hHook As Long
    #End If
    
    
    Private uParamStruct As MSLLHOOKSTRUCT
    Private oObject As Object
    #If VBA7 Then
        Private lLowLevelMouse As LongPtr
    #Else
        Private lLowLevelMouse As Long
    #End If
    
    
    Private bHooked As Boolean
    
    
    '====================='
    '\\ Public Routines   '
    '====================='
    
    
    Public Property Let MakeScrollableWithMouseWheel _
    (ByVal Obj As Object, ByVal vNewValue As Boolean)
    
    
        If vNewValue Then
            Hook_Mouse
        Else
            UnHook_Mouse
        End If
        
        Set oObject = Obj
        bHooked = vNewValue
    
    
    End Property
    
    
    
    
    Public Property Get MakeScrollableWithMouseWheel _
    (ByVal Obj As Object) As Boolean
    
    
        MakeScrollableWithMouseWheel = bHooked
    
    
    End Property
    
    
    
    
    
    
    '====================='
    '\\ Private Routines  '
    '====================='
    
    
    #If VBA7 Then
    Function LowLevelMouseProc _
        (ByVal ncode As Long, ByVal wParam As LongPtr, ByVal lParam As Long) As LongPtr
        
            Static iTopIndex As Integer
            
            On Error Resume Next
            
            If (ncode = HC_ACTION) Then
                If wParam = WM_MOUSEWHEEL Then
                    With oObject
                        If GetHookStruct(lParam).mousedata > 0 Then
                            .TopIndex = iTopIndex - 1
                            iTopIndex = .TopIndex
                        Else
                            .TopIndex = iTopIndex + 1
                            iTopIndex = .TopIndex
                        End If
                    End With
                    LowLevelMouseProc = -1
                    Exit Function
                End If
            End If
        
            LowLevelMouseProc = _
            CallNextHookEx(lLowLevelMouse, ncode, wParam, ByVal lParam)
    
    
    
    
    #Else
     Function LowLevelMouseProc _
        (ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        
            Static iTopIndex As Integer
            
            On Error Resume Next
            
            If (ncode = HC_ACTION) Then
                If wParam = WM_MOUSEWHEEL Then
                    With oObject
                        If GetHookStruct(lParam).mousedata > 0 Then
                            .TopIndex = iTopIndex - 1
                            iTopIndex = .TopIndex
                        Else
                            .TopIndex = iTopIndex + 1
                            iTopIndex = .TopIndex
                        End If
                    End With
                    LowLevelMouseProc = -1
                    Exit Function
                End If
            End If
        
            LowLevelMouseProc = _
            CallNextHookEx(lLowLevelMouse, ncode, wParam, ByVal lParam)
    #End If
    End Function
    
    
    Private Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT
    
    
       CopyMemory VarPtr(uParamStruct), lParam, LenB(uParamStruct)
       GetHookStruct = uParamStruct
        
    End Function
    #If VBA7 Then
    Private Function GetAppInstance() As LongPtr
    
    
        GetAppInstance = GetWindowLongPtr _
        (FindWindow("XLMAIN", Application.Caption), GWL_HINSTANCE)
    #Else
        Private Function GetAppInstance() As Long
    
    
        GetAppInstance = GetWindowLongPtr _
        (FindWindow("XLMAIN", Application.Caption), GWL_HINSTANCE)
    #End If
    
    
    End Function
    
    
    Private Sub Hook_Mouse()
    
    
        If lLowLevelMouse = 0 Then
            lLowLevelMouse = SetWindowsHookEx _
            (WH_MOUSE_LL, AddressOf LowLevelMouseProc, GetAppInstance, 0)
        End If
        
    End Sub
    
    
    Private Sub UnHook_Mouse()
        
        If lLowLevelMouse <> 0 Then _
        UnhookWindowsHookEx lLowLevelMouse: lLowLevelMouse = 0
        
    End Sub

  16. #16
    L'avatar di cinziorecoaro
    Clicca e Apri
    Data Registrazione
    Apr 2016
    LocalitÓ
    Recoaro Terme (VI)
    EtÓ
    37
    Messaggi
    34
    Versione Office
    2003+2010+2016
    Likes ricevuti
    3
    Likes dati
    4

    Re: Rotella del mouse in una combobox, varie versioni Excel

    Ora ho un altro problema che presenter˛ in una nuova discussione...

  17. #17
    L'avatar di max76
    Clicca e Apri
    Data Registrazione
    Apr 2017
    LocalitÓ
    Roma
    EtÓ
    41
    Messaggi
    7
    Versione Office
    2010
    Likes ricevuti
    0
    Likes dati
    0

    Re: Rotella del mouse in una combobox, varie versioni Excel

    Ciao Cinzio,

    ravvivo questo post perchÚ sono alla ricerca del codice da inserire in un userform dove ho collocato la ComboBox sperando di poter far funzionare lo scroll col mouse anche lý. Ho apprezzato molto che tu abbia creato le condizioni IF in modo da adattare il VBA al sistema sul quale viene eseguito. Una domanda. Il codice io lo devo usare su una Combobox di un userform di Word.

    Mi confermi che il codice vale anche per Word? A casa uso Word 2010 (64 bit) su Windows 10 mentre al lavoro usiamo Word 2010 (32 bit) su Windows 7 (64 bit).

    Grazie mille per il tuo supporto!

    Massimo

  18. #18
    L'avatar di Powerwin
    Clicca e Apri
    Data Registrazione
    Mar 2016
    LocalitÓ
    Milano
    Messaggi
    1404
    Versione Office
    2016 - 2010
    Likes ricevuti
    194
    Likes dati
    71

    Re: Rotella del mouse in una combobox, varie versioni Excel

    Ciao Max, non si riapre una discussione data come risolta, seppur con un problema simile.
    Apri una tua discussione esponendo la tua problematica e magari allegando un tuo file.
    Avvisi generali e importanti, pena CHIUSURA thread e/o BAN. Il crossposting Ŕ vietato. Le richieste di "pappa pronta" sono vietate. Utilizzate i tag CODE per il codice. Leggere il Regolamento per chiarimenti PRIMA di creare nuovi thread.



  19. #19
    L'avatar di max76
    Clicca e Apri
    Data Registrazione
    Apr 2017
    LocalitÓ
    Roma
    EtÓ
    41
    Messaggi
    7
    Versione Office
    2010
    Likes ricevuti
    0
    Likes dati
    0

    Re: Rotella del mouse in una combobox, varie versioni Excel

    Ciao Flavio,

    chiedo scusa ma sono nuovo su questo forum. Non so come si apre una nuova discussione.

    Max

  20. #20
    L'avatar di dracoscrigno
    Clicca e Apri
    Data Registrazione
    May 2016
    LocalitÓ
    ferrara
    EtÓ
    41
    Messaggi
    2074
    Versione Office
    office pro 2010
    Likes ricevuti
    440
    Likes dati
    241

    Re: Rotella del mouse in una combobox, varie versioni Excel

    Citazione Originariamente Scritto da max76 Visualizza Messaggio
    Ciao Flavio,

    chiedo scusa ma sono nuovo su questo forum. Non so come si apre una nuova discussione.

    Max
    in tutte le pagine, in alto, a sinistra, trovi il pulsante FORUM.
    lo clicchi e vieni teindirizzato alla radice del forum dove ci sono tutte le sezioni principali.

    scegli quella dove vuoi pubblicare cliccandoci sopra.
    vieni reindirizzato alla sezione scelta.

    a questo punto in alto a sinistra, SOTTO al men¨, noterai il pulsante CREA NUOVO o SCRIVI NUOVO non ricordo

  21. #21
    L'avatar di max76
    Clicca e Apri
    Data Registrazione
    Apr 2017
    LocalitÓ
    Roma
    EtÓ
    41
    Messaggi
    7
    Versione Office
    2010
    Likes ricevuti
    0
    Likes dati
    0

    Re: Rotella del mouse in una combobox, varie versioni Excel

    Grazie per la risposta. Fatto :)

Discussioni Simili

  1. Mouse che salta
    Di Silvio65 nel forum Domande su Excel in generale
    Risposte: 10
    Ultimo Messaggio: 21/02/17, 21:08
  2. Risposte: 30
    Ultimo Messaggio: 03/01/17, 07:34
  3. [Risolto] CompatibilitÓ con vecchie versioni
    Di Gianluca73 nel forum Domande su Excel in generale
    Risposte: 3
    Ultimo Messaggio: 19/09/16, 10:43
  4. Lista nomi file varie cartelle
    Di Mesinex nel forum Domande su Excel VBA e MACRO
    Risposte: 17
    Ultimo Messaggio: 11/01/16, 16:32
  5. Rotelle del mouse in VBA
    Di Baloon_50 nel forum Domande su Excel VBA e MACRO
    Risposte: 2
    Ultimo Messaggio: 21/12/15, 16:00

Tag per Questa Discussione

Permessi di Scrittura

  • Tu non puoi inviare nuove discussioni
  • Tu non puoi inviare risposte
  • Tu non puoi inviare allegati
  • Tu non puoi modificare i tuoi messaggi
  •