拨拨柚 2020-12-21 19:41 采纳率: 50%
浏览 65
已结题

VBA如何禁用滚轮?

单纯的通过Excel VBA

如何在不通过外部文件的情况下禁用滚轮

  • 写回答

3条回答 默认 最新

  • 歇歇 2020-12-22 16:21
    关注

    Option Explicit

    '   *****************************************************************************
    '   * ------------      MOUSE HOOK for Microsoft(r) Access VBA     ------------ *
    '   * ------------      (c) Wayne Phillips / iTech Masters 2009    ------------ *
    '   * ------------          http://www.everythingaccess.com        ------------ *
    '   *****************************************************************************
    '   *                                                                           *
    '   * This module exposes a function that creates an in-memory, COM-compatible  *
    '   * object that is written in native x86 code rather than VBA.                *
    '   *                                                                           *
    '   * The purpose of this module is to allow easy disabling of the mouse scroll *
    '   * wheel in Forms, without needing a DLL and without VBA problems usually    *
    '   * associated with subclassing windows:                                      *
    '   * http://support.microsoft.com/?kbid=278379                                 *
    '   * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*
    '   * All the benefits of using a native compiled DLL - without needing a DLL!  *
    '   *                                                                           *
    '   *   You are free to include this module in your project provided that you   *
    '   *  leave this copyright notice in place and that no modifications are made. *
    '   * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*
    '   * Instructions:                                                             *
    '   *                                                                           *
    '   *  1. Add an Object variable to the VBA code behind your form:              *
    '   *     Private MouseHook As Object                                           *
    '   *                                                                           *
    '   *  2. Add the following code to your OnOpen event:                          *
    '   *     Private Sub Form_Open(Cancel As Integer)                              *
    '   *         Set MouseHook = NewMouseHook(Me)                                  *
    '   *         MouseHook.Scroll = False                                          *
    '   *     End Sub                                                               *
    '   *                                                                           *
    '   *****************************************************************************

    Private Declare Function VirtualAlloc Lib "kernel32" (ByVal Address As Long, ByVal Size As Long, ByVal AllocationType As Long, ByVal Protect As Long) As Long
    Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal ProcName As String) As Long
    Private Declare Function GetProcAddress Lib "kernel32" (ByVal Module As Long, ByVal ProcName As String) As Long
    Private Declare Sub CopyMemoryAnsi Lib "kernel32" Alias "RtlMoveMemory" (ByVal Dest As Long, ByVal Source As String, ByVal Size As Long)
    Private Declare Sub CastToIUnknown Lib "kernel32" Alias "RtlMoveMemory" (ByRef Dest As stdole.IUnknown, ByRef Source As Long, ByVal Size As Long)

    Const SIZEOF_PTR32              As Long = &H4
    Const PAGE_EXECUTE_RW           As Long = &H40
    Const MEM_RESERVE_AND_COMMIT    As Long = &H3000
    Const ERR_OUT_OF_MEMORY         As Long = &H7

    Public Function NewMouseHook(ByRef Form As Access.Form) As Object

        Dim NativeCode As String
        Dim Kernel32Handle As Long
        Dim GetProcAddressPtr As Long
        Dim MouseHookAddr As Long
        Dim MouseHookIUnk As stdole.IUnknown
        
        NativeCode = _
                "XYQPSWQ[T_S\\[S\XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX- %uUPXX-%ueeT[PXX-E%%ePXX-uu0E-uu0EPXX-eeE%PXX-%e%uPXX-eeE PXX-%eE PXXX@@fX<0tF4+&4+2'&,V/PCp@-''2V/5+1''3V/ys 1S CCCuRfI>_ltcDPC@KCqc@uIcLBAA@eIRdQQAIEQSDEQSH=_YHAHeHAAA@A^E@AA>JAAAloAA@A?B@AAnLAAA\rAA@qNB@AAyMAAAhAAA@UtclNIpt^]P<[VPXKpcEp>bPpQcU ?bM ? ypCAuPqM@n_LKWDBCkoAtTPajbaA@AQ\MmYRxBY_tAQ\DMBqkbp>uPp>u@p>upq>u pcU ??rpscM ??QPucevdqPAAePWtclNIppbG<AAAAhrTJ@AQWIWE>sA]cE ?bU ?bMpnpDEpU?WE?KWE?KWD>FRaAU<_PxnYRxnYP<[M@Hmy>E ?bU ?bMpnpDE@z?WE?KWE?KWD>FRaAS<_PxnYRxnYP<[M@HMy>E ?bU ?bMpnpDEP^?WE?KWE?KWD>FRaAT=_PxnYRxnYP<[M@HAq>E ?bU ?bMpnpDEP\?WE?KWE?KWD>FRaAK=_PxnYRxnYP<[M@Haz>E ?bU ?bMpnpDE @?WE?KWE?KWD>FRaA@<_PxnYRxnYP<[M@HAq>E ?bU ?bMpnpDE@a?WE?KWE?KWD>FRaAY<_PxnYRxnYP<[M@Hut>E ?bU ?bMpnpDEpW?WE?KWE?KWD>FRaAB>_PxnYRxnYP<[M@Hqq>E ?bU ?bMpnpDE@A?WE?KWE?KWD>FRaAK?_PxnYRxnYP<[M@HUt>E ?bU ?bMpnpDE@B?WE?KWE?KWD>FRaAC?_PxnYRxnYP<[M@HI=?E ?bU ?bMpnpDE@@?WE?KWE?KWD>FRaAK?_PxnYRxnYP<[M@HIp>E ?bU ?bMpnpDEPc?WE?KWE?KWD>FRaA" & _
                "U<_PxnYRxnYP<[M@Hq>?E ?bU ?bMpnpDEpa?WE?KWE?KWD>FRaAz<_PxnYRxnYP<[M@HQq>E ?bU ?bMpnpDE@A?WE?KWE?KWD>FRaAu<_PxnYRxnYP<[M@Hip>E ?bU ?bMpnpDEPo?WE?KWE?KWD>FRaAC=_PxnYRxnYP<[M@HAq>E ?bU ?bMpnpDE@A?WE?KWE?KWD>FRaA@=_PxnYRxnYP<[M@Hmy>E ?bU ?bMpnpDEPP?WE?KWE?KWD>FRaAL=_PxnYRxnYP<[M@Hey>E ?bU ?bMpnpDEpq?WE?KWE?KWD>FRaAC?_PxnYRxnYP<[M@HA=?E ?bU ?bMpnpDE@B?WE?KWE?KWD>FRaAy=_PxnYRxnYP<[M@Hiu>E ?bU ?bMpnpDE@C?WE?KWE?KWD>FRaAt<_PxnYRxnYP<[M@Haq>E ?bU ?bMpnpDEPA?WE?KWE?KWD>FRaAX=_PxnYRxnYP<[M@HMy>E ?bU ?bMpnpDE@q?WE?KWE?KWD>FRaAD=_PxnYRxnYP<[M@HEu>E ?bU ?bMpnpDEp;?WE?KWE?KWD>FRaAs>_PxnYRxnYP<[M@HMy>E ?bU ?bMpnpDE ^?WE?KWE?KWD>FRaAD=_PxnYRxnYP<[M@HAq>E ?bU ?bMpnpDEP\?WE?KWE?KWD>FRaAF=_PxnYRxnYP<[M@Hmy>E ?bU ?bMpnpDEPR?WE?KWE?KWD>FRaAL=_PxnYRxnYP<[M@Hey>E ?bU ?bMpnpDE R?WE?KWE?KWD>FRaAD=_PxNRsIwE<ifL@@Aq[EPNFACM>m^EAIWE=KWD?KwE>FRQEK?_PxnYPxnYT<[M@Buu>E ?bM ?bEpnpDaAE?WE?KWD?KwE>FRQEA?_PxnYPxnYT<[M@Bev>E ?bM ?bEpnpDaAA?WE?KWD=JkAaa>?bE ?bUpNcLIq>E ?bM@>bAEM;HQs>KWD?KwE>HSQE?WE?KWE=" & _
                "KCPqjB@ab>?bM ?bEpNcTaq>E ?bU@>bJE];XAYy?oYPxnYT<cIBB=_PxnYRxnYP<[M@HUv>E ?bU ?bMpnpDEpN?WE?KWE?KWD>FRaAA?_PxnYRxnYP<[M@Hev>E ?bU ?bMpnpDE@@?WE?KWE=JCD@@K??KwE?KWE>HS@C?WE?KWD=KkE@AfOC@G??KWE?KWD>HsaA?WE?KwE=KGE@AbOEd=?bU ?bMpNcDEp>E ?bE@>bPPQqjb@ab>?bM ?bEpNcTaq>E ?bU ?bMpnpDEP\?WE?KWE?KWD>FRaAv=_PxnYRxnYP<[M@HEy>E ?bU ?bMpnpDEP_?WE?KWE?KWD>FRaAH=_PxnYRpjYQHQs>KWD?KwE>HSQE?WE?KWE=KCDCAjOC@K??KwE?KWE>HS@C?WE?KWD=KkECAfOE@G??KWE?KWD>HsaA?WE?KwE=KGECAbOGd=?bU ?bMpNcDEp>E ?bE ?bUpnpDIQ\?WE?KwE?KWE>FRACm=_PxnYTxnYR<[M@QEy>E ?bE ?bUpnpDIQ_?WE?KwE?KWE>FRACL=_PxnYTpjiSLAYy?oYPxnYT<cIBB=_PxnYRpnYQLEM;HQs>KWD?KwE>HSQE?WE?KWE=KCDBAjOE@K??KwE?KWE>HS@C?WE?KWD=KkEBAfOG@G??KWE?KWD>HsaA?WE?KwE?KWE>FRACu<_PxnYTxnYR<[M@QQs>E ?bE ?bUpnpDIqc?WE?KwE?KWE>FRACE<_PxnYTxnYR<[M@Qq>?E ?bE ?bUpnpDIqc?WE?KwE?KWE>FRACP<_PxnYTxnYR<[M@QQq>E ?bE ?bUpnpDIQa?WE?KwE?KWE>FRACB>_PxnYTtnisAJ?@kElcDUHBn^EAABoAd=?bU ?bMpNcDEp>E ?bEP>bPFMyCmcqKsQ Ly?Q@E]yBE]?HAYy?oYPxnYT<cIBB=_PxnYRtnYqAF?@ka=bTuIBn^EAAJoA" & _
                "AjNE@K??KwE?KWE>HS@C?WE?KWD<Kk]qbNqKQnI@UsazG@Qq KQqxb@H?oYTxnYR<cI@Q=_PxnYPxnYT<[M@Bmy>E ?bM ?bEpnpDaQR?WE?KWD?KwE>FRQET=_PxnYPxnYT<[M@Bey>E ?bM ?bEpnpDaQE?WE?KWD?KwE>FRQEK?_PxnYPxnYT<[M@BUu>E ?bM ?bEpnpDaAD?WE?KWD?KwE>FRQEK?_PxnYPxnYT<[M@BAp>E ?bM ?bEpnpDaaU?WE?KWD?KwE>FRQEK?_PxnYPxnYT<[M@Biq>E ?bM ?bEpnpDaq>?WE?KWD?KwE>FRQEQ<_PxnYPxnYT<[M@BQq>E ?bM ?bEpnpDaqM?WE?KWD?KwE>FRQE@>_PxnYPxnYT<[M@Bet>E ?bM ?bEpnpDaQV?WE?KWD?KwE>FRQE[<_PxnYPxnYT<[M@BI=?E ?bM ?bEpnpDaAB?WE?KWD?KwE>FRQE@=_Px>_PtnYPtnR@XG?Q@= aXm>??oYTxnYR<[M@Qmy>E ?bE ?bUpnpDIQR?WE?KwE?KWE>FRACT=_PxnYTxnYR<[M@Q]=?E ?bE ?bUpnpDIQA?WE?KwE?KWE>FRAC@=_PxnYTxnYR<[M@QAq>E ?bE ?bUpnpDIAA?WE?KwE?KWE>FRAC@=_PxnYTxnYR<[M@Qaz>E ?bE ?bUpnpDIaA?WE?KwE?KWE>FRAC@<_PxnYTxnYR<[M@QAq>E ?bE ?bUpnpDIAa?WE?KwE?KWE>FRACK?_PxnYTxnYR<[M@QA=?E ?bE ?bUpnpDIqc?WE?KwE?KWE>FRAC@>_PxnYTxnYR<[M@Qet>E ?bE ?bUpnpDIQV?WE?KwE?KWE>FRAC[<_PxnYTxnYR<[M@QI=?E ?bE ?bUpnpDIAB?WE?KwE?KWE>FRAC@=_PxnYTxnYR<[M@QAx>E ?bEp>bevtqUlIzQlYPHMIqDmIEIWD>KwE>" & _
                "CgF@@UVCKWECKWD>IKE@KC=b@nYR<oYA?GQW]HM@@AHePOTTKs?TCwFD@UvCxKAQ@AYW]ldqLAqcUpqaBRqcReYT<Oi_DAQ\ZezA@AAAKWEBIO= @rQOJ @\HEAGCCM@Al?<CkF@@Uf@KwEBIkE@KwEEAgFA@QaA@UvNAgF@@AAA@UfLAgFC@BAA@UVJAgFB@AAAFTFHKWE>KCD@AKMA@AAAKwEDIGpcEPpcPItcJ=_UDMBqYttWBrAAKwEDGFAA@AAAxKAQ@Ayc@nIqYttWBrAAUlIzQlYPHMIqDmIEIWD>KwE>CgF@@UVCKWECKWD>IKE@KC=b@nYR<oYA?GQW]HM@@AHePWtclNIptNtcE pa@RqcPeYT<oYR<OY_DAQ\ImYPHmYT<giQDmYR<?_CKWE>CcBAOUId@AAAKWD>KkEBCgFJ@QFKKWE>KCDB?KFJjp>bMp>bApq>p@rcUp>bJpq>Q tcEp>bPpqMIfiSlmYP<oIULMiO@QfBKwE>KGEBKC TKkq>Q pcEp>bPpqcJ@UcM ?bEp>bPPQajbLA@AQcUP>bMp>?qpqcEp>bPpqcJEtcA=OUTmYPxnYRtfIz]ltaDRA[@AIA@iGAQLt> oIqKC=bUp>bBmtcevdqDAAePCXTKs_UKWECCCM@KCPcUp>b@nIqxGAQ@AYW]HMC@AHePWtclFtcE pa@RqcPeYT<oIqKCMoAAEA@gTVBB@APCHeUlIzQlYPHMIqDmIEIWD>CwFDAQfCxGAQ@AY;>BAA@mYTPmiCfLYOITVNKWEEKC YCkfAnTVMKwEEKGaXCcF@iTVHKWDEKkaXCgf@tTVGKWEEKC YCkFC@UVBKwEFGFQA@AAAsA=zvlYTPmiCfLYOSTVTKWEEKC YCkfAcTVSKwEEKGaXCcF@rTVNKWDEKkaXCgf@oTVMKWEEKC YCkFClTVHKwEEKGaXCcfClTVGKWDEKkaXCgFB@UVBKWEF" & _
                "GBaA@AAAsA=zVmYT\]mA?????cj@@IAakZqc@nIqsA]W]HMG@AHeUlIzCSMsKWECCCM@KCPcUp> =qAAu\qpEpaA@AAACwFBA=P HKAA@mYR\MY_HMA\JajB@IAai><@@Aqa=ACAt pcU@cXGJQA@mYR\mYAvBUI@PvBKWDFKkqcA rcPeYTxn?BKwEFKGqcP RcU ?bMppcAYNQQAE\OmYT\miCKGEGKCPcUP>zKmYR\mYAKCDGIWD<KwE>CGmZQ<_\x>_TtfYPpnYP<OIq?At>U@^cEp?bUp^aBVIA@AaU?WD=IWE;KwE>AGmb@AAAQ<_\l>_TtfYPdvYP Cd[A=_TdjGUKWDyRliC?GDBKWD>IKEBKWE>EiHA@AAU?WD=KwE>KGDBIKEHKWE>EEKA@AAUKwE>KGEB?CFH?WD<KWD>KkEBIGEPKWE>EEJA@AAUKWD>KkEB?GFH?WD<KWD>KkEBIGESKWE>KCEBsI\cP rMIfYR\nYP\mIEIWDwKwEwO]ZA=HAQ@Aq^QQVQCcoAt@BStTpahzA\BloWmMAQ@AA\RMI;NQVQkrucU =bJ PcMp<zAlYPXnIUHmiCIwEvkRrcE =C?BDCIWDvkbscM =bA pB?BPcUp<zZmYRXNBqJGECIWEvkvqcU =bJ pM@jYAIWEvKWD>KkEBKWEvIGEMKWD>KkEBFFELAmYP<WAq@AAAP<_\x>_TtnYT<oiSLeYQ@lYP<oIULmYR giCKWE>KCDBKwE=IkENKWE>KCDBKwE<IkEOKWE>KCDBKwE?IkEGKWE>KCDBKwEzIkEFKWE>KCDBKwE;IkEIKWE>KCDBKwECIkEKKWECKCpcJpPcMP<L@fYPPnYTTNQTPFiOvTEgRUvCKwEtCuEuKWE>IGq>E@\a=ALs@AAA<m<?uPl[<oYT<oiSL=_]pmYP<oIUL=oUHlYR<oYULeiQlMBqi>UA@AQ;MDAA@MY^LIqBEOUA" & _
                "@AaXCwFGBQfBfLY^XMA\GYwa=aPAuxucMppay @AthAoNAaA@gOKAAAACwFI@QFHKWDIf\mAKAqcMp>bApAaxPBAtTqaJ>?zBMbuKWEIfdIUHmoCx;@ABAY;tBAA@MBqivOA@AaXCwFGD=P UBAA@mYT\Mi_HEA\JajB@IAai>LA@AqMRfYTLnYR\mYAIWEsKWDsO]jCAgnA@@AA?Y@\LLY;BQvOIPFICgOCtdwaiZA\Hlo_Ag?@@@AAt\paibA\aLY;FQVQkZwcE <bP PcUp=z[lYRHnYQHmIEIWDrkzucM <C?FECIWErkJucU <bJ pB?FQcEp=ztmYTHNRsJkECIwErk^scE <bP pMIjiCIwErkbpcE <C?BDCIWDrkrqcM <bA pB?BPcUp= =qMAOUXqCG_AKWE>KCDBHkELsA=zMazA@IAakZqc@nIqsA=bevdqdAAA@AAA@AAA@iAA@AAA@AAAC@qZ@AFAy@a]@eGAg@A[@QFA @qT@EGAy@aZ@UGA @AU@aGAi@AZ@qGAi@A]@MFA @qJ@ACAi@AT@UGAc@A[@ACAM@QY@MFAt@QX@IFAs@AI@IBApAAM@aBA@AAA@]UXttuZdTFZe TYnPGZeDEAOpUPsIBAOpUPATF\sIBAC<vPePVRapGZoLGAULTPRLbM@MUYlpwTixGXo\FUr<vYA@qUePvTixGXo\FRoxwXA@aTiHF\uDGZFHVXe@AA0"
                
        ' Allocate the executable memory for the object
            MouseHookAddr = VirtualAlloc(0, Len(NativeCode), MEM_RESERVE_AND_COMMIT, PAGE_EXECUTE_RW)

        If MouseHookAddr <> 0 Then
        
            ' Copy the x86 native code into the allocated memory
                Call CopyMemoryAnsi(MouseHookAddr, NativeCode, Len(NativeCode))
               
            ' Force the memory address into an Object variable
                Call CastToIUnknown(MouseHookIUnk, VarPtr(VarPtr(MouseHookAddr)), SIZEOF_PTR32)
                Set NewMouseHook = MouseHookIUnk
                Call CastToIUnknown(MouseHookIUnk, 0, SIZEOF_PTR32)
            
            ' Initialize our COM object
                Kernel32Handle = GetModuleHandleA("kernel32")
                GetProcAddressPtr = GetProcAddress(Kernel32Handle, "GetProcAddress")
                Call NewMouseHook.Init(Kernel32Handle, GetProcAddressPtr, Form.hwnd)
            
        Else
        
            Err.Raise ERR_OUT_OF_MEMORY
        
        End If
        
    End Function
     

    评论

报告相同问题?

悬赏问题

  • ¥15 求差集那个函数有问题,有无佬可以解决
  • ¥15 【提问】基于Invest的水源涵养
  • ¥20 微信网友居然可以通过vx号找到我绑的手机号
  • ¥15 寻一个支付宝扫码远程授权登录的软件助手app
  • ¥15 解riccati方程组
  • ¥15 display:none;样式在嵌套结构中的已设置了display样式的元素上不起作用?
  • ¥15 使用rabbitMQ 消息队列作为url源进行多线程爬取时,总有几个url没有处理的问题。
  • ¥15 Ubuntu在安装序列比对软件STAR时出现报错如何解决
  • ¥50 树莓派安卓APK系统签名
  • ¥65 汇编语言除法溢出问题