2017-08-01 14 views
0

勘定コード表に埋め込まれたマクロを継承しました。 32ビットマシンで使用すると効果的です。 64ビットマシンが徐々に展開されており、ユーザーは64ビットマシンでマクロに問題があります。ユーザは検索ボタンを押してポップアップウィンドウを表示する。彼らは口座番号を入力し、「検索」ボタンを押して、入力したものの最初のインスタンスに移動します。彼らが "find"を再び押すと、2番目のインスタンスに移動します。64ビットマシンでマクロを使用すると型の不一致エラーが発生する

私は各宣言に「ptrsafe」と入力しなければならないことを知っています。私はすでにそれを行っています。しかし、現在、MsgBoxEx関数で型の不一致エラーが発生しています。この関数では "AddressOf zWindowProc"が強調表示されています。

変更する必要があるものは誰でも手助けできますか?あなたの助けをありがとう.........

Option Explicit 

Public Enum ePosMsgBox 
    eTopLeft 
    eTopRight 
    eTopCentre 
    eBottomLeft 
    eBottomRight 
    eBottomCentre 
    eCentreScreen 
    eCentreDialog 
End Enum 

Private Type RECT 
    Left As Long 
    Top As Long 
    Right As Long 
    Bottom As Long 
End Type 

Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal zlhHook As Long) As Long 

Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long 

Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32"() As Long 

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 

Private Declare PtrSafe 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 PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long 

Private Const GWL_HINSTANCE = (-6) 
Private Const SWP_NOSIZE = &H1 
Private Const SWP_NOZORDER = &H4 
Private Const SWP_NOACTIVATE = &H10 
Private Const HCBT_ACTIVATE = 5 
Private Const WH_CBT = 5 

Private Declare PtrSafe Function GetForegroundWindow Lib "user32"() As Long 

Private Declare PtrSafe Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long 

Private zlhHook As Long 
Private zePosition As ePosMsgBox 

Function MsgboxEx(Prompt As String, Optional Buttons As VbMsgBoxStyle, Optional Title, Optional HelpFile, Optional Context, Optional Position As ePosMsgBox) As VbMsgBoxResult 
    Dim lhInst As Long 
    Dim lThread As Long 

    lhInst = GetWindowLong(GetForegroundWindow, GWL_HINSTANCE) 
    lThread = GetCurrentThreadId() 
    zlhHook = SetWindowsHookEx(WH_CBT, AddressOf zWindowProc, lhInst, lThread) 

    zePosition = Position 

    MsgboxEx = MsgBox(Prompt, Buttons, Title, HelpFile, Context) 
End Function 

Private Function zWindowProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
    Dim tFormPos As RECT, tMsgBoxPos As RECT, tScreenWorkArea As RECT 
    Dim lLeft As Long, lTop As Long 
    Static sbRecursive As Boolean 

    If lMsg = HCBT_ACTIVATE Then 
     On Error Resume Next 
     tScreenWorkArea = ScreenWorkArea 
     GetWindowRect GetForegroundWindow, tFormPos 
     GetWindowRect wParam, tMsgBoxPos 

     Select Case zePosition 
     Case eCentreDialog 
      lLeft = (tFormPos.Left + (tFormPos.Right - tFormPos.Left)/2) - ((tMsgBoxPos.Right - tMsgBoxPos.Left)/2) 
      lTop = (tFormPos.Top + (tFormPos.Bottom - tFormPos.Top)/2) - ((tMsgBoxPos.Bottom - tMsgBoxPos.Top)/2) 

     Case eCentreScreen 
      lLeft = ((tScreenWorkArea.Right - tScreenWorkArea.Left) - (tMsgBoxPos.Right - tMsgBoxPos.Left))/2 
      lTop = ((tScreenWorkArea.Bottom - tScreenWorkArea.Top) - (tMsgBoxPos.Bottom - tMsgBoxPos.Top))/2 

     Case eTopLeft 
      lLeft = tScreenWorkArea.Left 
      lTop = tScreenWorkArea.Top 

     Case eTopRight 
      lLeft = tScreenWorkArea.Right - (tMsgBoxPos.Right - tMsgBoxPos.Left) 
      lTop = tScreenWorkArea.Top 

     Case eTopCentre 
      lLeft = ((tScreenWorkArea.Right - tScreenWorkArea.Left) - (tMsgBoxPos.Right - tMsgBoxPos.Left))/2 
      lTop = tScreenWorkArea.Top 


     Case eBottomLeft 
      lLeft = tScreenWorkArea.Left 
      lTop = tScreenWorkArea.Bottom - (tMsgBoxPos.Bottom - tMsgBoxPos.Top) 

     Case eBottomRight 
      lLeft = tScreenWorkArea.Right - (tMsgBoxPos.Right - tMsgBoxPos.Left) 
      lTop = tScreenWorkArea.Bottom - (tMsgBoxPos.Bottom - tMsgBoxPos.Top) 

     Case eBottomCentre 
      lLeft = ((tScreenWorkArea.Right - tScreenWorkArea.Left) - (tMsgBoxPos.Right - tMsgBoxPos.Left))/2 
      lTop = tScreenWorkArea.Bottom - (tMsgBoxPos.Bottom - tMsgBoxPos.Top) 

     End Select 

     If lLeft < 0 And sbRecursive = False Then 
      sbRecursive = True 
      zePosition = eCentreScreen 
      zWindowProc HCBT_ACTIVATE, wParam, lParam 
      sbRecursive = False 
      Exit Function 
     End If 

     SetWindowPos wParam, 0, lLeft, lTop, 10, 10, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE 

     UnhookWindowsHookEx zlhHook 
    End If 
    zWindowProc = False 

End Function 

Function ScreenWorkArea() As RECT 
    Dim tScreen As RECT 
    Dim lRet As Long 
    Const SPI_GETWORKAREA = 48 

    lRet = SystemParametersInfo(SPI_GETWORKAREA, vbNull, tScreen, 0) 
    ScreenWorkArea = tScreen 
End Function 
+0

ここでは、この上で良い記事です:私が研究していた間、私は少し前ということに遭遇していたhttp://www.jkp-ads.com/articles/apideclarations.asp –

+0

おかげで....この問題。これらのAPIは私の頭の上にありますが、私は見て、私がそれを理解することができるかどうかを見てみましょう......助けをもう一度おねがいします....... – Shaves

答えて

0

私は私の問題を解決することができました。私はこのフォーラムで別の質問でこのリンクを見つけました。大きな助けとなりました。私は行ごとに行って、宣言文ごとに64ビットバージョンを追加しました。また、64ビットバージョンにいくつかの変数を変更しなければなりませんでした。現在、32ビットまたは64ビットマシンのいずれかで動作しています。
http://www.cadsharp.com/docs/Win32API_PtrSafe.txt

関連する問題