trash-area.com ≫ blog ≫ EXCEL ≫ VBAでドラッグ&ドロップ
探してみたんですけどなかなか時間かかったので。
VBAでドラッグ&ドロップのドロップをシミュレートします。
まぁ用途はあまり無いんですけどね。
ファイル名がリストされてるテキストをインプットにできないアプリで使用しました。
Private Type POINTAPI x As Long y As Long End Type Private Type DROPFILES pFiles As Long pt As POINTAPI fNC As Long fWide As Long End Type Private Const WM_DROPFILES = &H233 Private Const GMEM_MOVEABLE = &H2 Private Const GMEM_ZEROINIT = &H40 Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT) Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public Sub drop_test() Dim files As Variant, v As Variant files = Array( _ , "D:\work\test1.vbs" _ , "D:\work\test2.vbs" _ , "C:\Documents and Settings\hoge\デスクトップ\新規テキスト ドキュメント (3).txt" _ , "C:\Documents and Settings\hoge\デスクトップ\新規テキスト ドキュメント (4).txt" _ ) Dim tDropFiles As DROPFILES, DROPFILE_SIZE As Long DROPFILE_SIZE = LenB(tDropFiles) Dim fileNamesSize As Long ' ファイル名の長さを計算 ' (ファイル名+\0)+(ファイル名+\0)+...+(ファイル名+\0)+(\0) For Each v In files fileNamesSize = fileNamesSize + lstrlen(v) + 1 Next fileNamesSize = fileNamesSize + 1 ' メモリの確保(DROPFILESのサイズ+ファイル名の長さ分) Dim hMem As Long hMem = GlobalAlloc(GHND, DROPFILE_SIZE + fileNamesSize) tDropFiles.pFiles = DROPFILE_SIZE Dim pDropFiles As Long pDropFiles = GlobalLock(hMem) ' ファイル名を除いた分をコピー Call CopyMemory(ByVal pDropFiles, tDropFiles, DROPFILE_SIZE) ' ファイル名部分のコピー pDropFiles = pDropFiles + DROPFILE_SIZE For Each v In files Call lstrcpy(pDropFiles, ByVal CStr(v)) pDropFiles = pDropFiles + lstrlen(v) + 1 Next Call GlobalUnlock(hMem) ' メッセージをポスト Dim hwnd As Long hwnd = &H480810 'とりあえず直書き Call PostMessage(hwnd, WM_DROPFILES, hMem, 0) Call GlobalFree(hMem) End Sub |
2013.06.22 @ 5:22 AM
すいません。
記述場所とか使い方がさっぱりわかりません。
どこにドロップしたら、どう反応するのかも…
もう少し詳しく解説願えませんか?