[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『メモ帳内容の全範囲を選択しクリップボード格納(API使用)』(のらじろう)
こんにちは、よろしくお願いいたします。
↓の質問の続きのような質問です。 [[20150326105138]] 『開いているメモ帳(複数)の選択範囲の文字列を取得』(のらじろう)
先日の質問のコードを少し変えて開いているメモ帳の全範囲を選択して新規テキストファイル保存、という コードを作成中です。
なるべくSendKeysを使わないように変えてみました。 途中まではうまくいっているのですが、コードの末尾に★を付けている部分がうまくいきません。
「WM_COMMAND」で25を与えてメモ帳の全範囲を選択し、その次に「WM_COPY」で選択範囲をコピー しクリップボードに格納する、という部分です。 全範囲選択はうまくいってます。その次のコピーする、という部分がうまくいきません。 エラーにはならないのですが、クリップボードには何も格納されません。
どのように変えたらいいでしょうか? ヒントや参考HPでも構いません。ご教示いただきましたら幸いです。
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" ( _ ByVal hWnd As Long, _ ByVal lpString As String, _ ByVal cch As Long _ ) As Long
Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" ( _ ByVal hWnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long _ ) As Long
Declare Function IsWindowVisible Lib "user32.dll" (ByVal hWnd As Long) As Long
Declare Function IsWindowEnabled Lib "user32.dll" (ByVal hWnd As Long) As Long
Declare Function EnumWindows Lib "user32.dll" ( _ ByVal lpEnumFunc As Long, _ lParam As Long _ ) As Long
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
Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _ ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
Declare Function OpenClipboard Lib "user32" _ (ByVal hWndNewOwner As Long) As Long Declare Function CloseClipboard Lib "user32" () As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Const WM_QUIT As Long = &H12 Const WM_COMMAND As Long = &H111 Const WM_COPY As Long = &H301 Const WM_COPYDATA As Long = &H4A
Dim CB As New DataObject Dim ary() As Variant Dim cnt As Integer
Function EnumWindowsProc(ByVal hWnd As Long, lParam As Long) As Long Dim mycls As String Dim StrCls As String Dim StrCap As String
StrCap = String(255, Chr(0)) Call GetWindowText(hWnd, StrCap, Len(StrCap))
StrCls = String(50, Chr(0)) Call GetClassName(hWnd, StrCls, Len(StrCls))
mycls = Left(StrCls, InStr(1, StrCls, Chr(0)) - 1) If mycls = "Notepad" Then cnt = cnt + 1 ReDim Preserve ary(1, cnt) ary(0, cnt) = hWnd ary(1, cnt) = Left(StrCap, InStr(1, StrCap, Chr(0)) - 1) End If EnumWindowsProc = 1 End Function
Sub SampleEnumWindows() Dim myhwnd As Long Dim i As Integer Dim txtpath As String Dim genzai As String Dim ernum As Long Dim cbstr As String Dim cntb As Integer Dim selstrary() As Variant Dim folpath As String ernum = -2147221404 genzai = Format(Now, "yymmdd_hhmmss") folpath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & genzai cnt = -1 Call EnumWindows(AddressOf EnumWindowsProc, 0) If cnt <> -1 Then cntb = -1 For i = 0 To cnt myhwnd = ary(0, i) Call cbclr Call SetForegroundWindow(myhwnd) Sleep 50 Call PostMessage(myhwnd, WM_COMMAND, 25, 0) Sleep 100 'Call SendMessage(myhwnd, WM_COPYDAT, 0, 0) 'ここは今回は使ってません Call SendMessage(myhwnd, WM_COPY, 0, 0) '★ Sleep 100 Err.Clear cbstr = "" With CB On Error Resume Next .GetFromClipboard cbstr = .GetText 'MsgBox cbstr End With If Err.Number = ernum Then Else cntb = cntb + 1 If cntb = 0 Then MkDir (folpath) ReDim Preserve selstrary(1, cntb) selstrary(0, cntb) = cbstr selstrary(1, cntb) = ary(1, i) End If Call PostMessage(myhwnd, WM_QUIT, 0, 0) On Error GoTo 0 Next i If cntb <> -1 Then For i = 0 To cntb txtpath = folpath & "\" & genzai & "_" & Format(i, "00") & "_" & selstrary(1, i) & ".txt" Call TxtOutput(txtpath, CStr(selstrary(0, i))) Next i End If If cntb <> -1 Then Erase selstrary End If If cnt <> -1 Then Erase ary Call cbclr End Sub
Function cbclr() If OpenClipboard(0) Then EmptyClipboard CloseClipboard End If End Function
Function TxtOutput(ByVal newtxtpath As String, newtxtstr As String) Dim fnum As Integer fnum = FreeFile Open newtxtpath For Output As #fnum Print #fnum, newtxtstr; Close fnum End Function
< 使用 Excel:unknown、使用 OS:WindowsVista >
↓のように追加、変更することでうまくいきました。お騒がせしました。
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'○追加 Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _ (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _ ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" ( _ ByVal hWnd As Long, _ ByVal lpString As String, _ ByVal cch As Long _ ) As Long
Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" ( _ ByVal hWnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long _ ) As Long
Declare Function IsWindowVisible Lib "user32.dll" (ByVal hWnd As Long) As Long
Declare Function IsWindowEnabled Lib "user32.dll" (ByVal hWnd As Long) As Long
Declare Function EnumWindows Lib "user32.dll" ( _ ByVal lpEnumFunc As Long, _ lParam As Long _ ) As Long
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
Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _ ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
'Declare Function SendMessageAny Lib "user32.dll" _
Alias "SendMessageA" _ (ByVal hWnd As Long, _ ByVal Msg As Long, _ ByVal wParam As Long, _ ByVal lParam As Any) As Long
Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
Declare Function OpenClipboard Lib "user32" _ (ByVal hWndNewOwner As Long) As Long Declare Function CloseClipboard Lib "user32" () As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Const WM_QUIT As Long = &H12 Const WM_COMMAND As Long = &H111 Const WM_COPY As Long = &H301 Const WM_COPYDATA As Long = &H4A
Dim CB As New DataObject Dim ary() As Variant Dim cnt As Integer
Function EnumWindowsProc(ByVal hWnd As Long, lParam As Long) As Long Dim mycls As String Dim StrCls As String Dim StrCap As String
StrCap = String(255, Chr(0)) Call GetWindowText(hWnd, StrCap, Len(StrCap))
StrCls = String(50, Chr(0)) Call GetClassName(hWnd, StrCls, Len(StrCls))
mycls = Left(StrCls, InStr(1, StrCls, Chr(0)) - 1) If mycls = "Notepad" Then cnt = cnt + 1 ReDim Preserve ary(1, cnt) ary(0, cnt) = hWnd ary(1, cnt) = Left(StrCap, InStr(1, StrCap, Chr(0)) - 1) End If EnumWindowsProc = 1 End Function
Sub SampleEnumWindows() Dim myhwnd As Long Dim lnghWndTarget As Long '○追加 Dim i As Integer Dim txtpath As String Dim genzai As String Dim ernum As Long Dim cbstr As String Dim cntb As Integer Dim selstrary() As Variant Dim folpath As String ernum = -2147221404 genzai = Format(Now, "yymmdd_hhmmss") folpath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & genzai cnt = -1 Call EnumWindows(AddressOf EnumWindowsProc, 0) If cnt <> -1 Then cntb = -1 For i = 0 To cnt myhwnd = ary(0, i) Call cbclr Call SetForegroundWindow(myhwnd) Sleep 50 Call PostMessage(myhwnd, WM_COMMAND, 25, 0) Sleep 50 lnghWndTarget = FindWindowEx(myhwnd, 0, "Edit", "") '子ウィンドウのEdit '○追加 Call SendMessage(lnghWndTarget, WM_COPY, 0, 0) '★変更 Sleep 50 Err.Clear cbstr = "" With CB On Error Resume Next .GetFromClipboard cbstr = .GetText 'MsgBox cbstr End With If Err.Number = ernum Then Else cntb = cntb + 1 If cntb = 0 Then MkDir (folpath) ReDim Preserve selstrary(1, cntb) selstrary(0, cntb) = cbstr selstrary(1, cntb) = ary(1, i) End If Call PostMessage(myhwnd, WM_QUIT, 0, 0) On Error GoTo 0 Next i If cntb <> -1 Then For i = 0 To cntb txtpath = folpath & "\" & genzai & "_" & Format(i, "00") & "_" & selstrary(1, i) & ".txt" Call TxtOutput(txtpath, CStr(selstrary(0, i))) Next i End If If cntb <> -1 Then Erase selstrary End If If cnt <> -1 Then Erase ary Call cbclr End Sub
Function cbclr() If OpenClipboard(0) Then EmptyClipboard CloseClipboard End If End Function
Function TxtOutput(ByVal newtxtpath As String, newtxtstr As String) Dim fnum As Integer fnum = FreeFile Open newtxtpath For Output As #fnum Print #fnum, newtxtstr; Close fnum End Function (のらじろう) 2015/05/17(日) 22:29
教えてください。
メモ帳でテキストファイルを3つ開いておき、それぞれ、コピーしたい部分をマウスで選択した上で アップされた改訂版コードを実行しましたら、デスクトップにできたフォルダに、3つのテキストファイルと全く同じ内容のものが 3つコピーされていただけでした。
なにか、操作を間違えているのでしょうか?
(β) 2015/05/18(月) 08:41
βさん、レスありがとうございます。
今回のコードは Call PostMessage(myhwnd, WM_COMMAND, 25, 0) でメモ帳の全範囲を選択状態にしております。
ですので、コピー元のメモ帳と同じ内容が新しいメモ帳 に転記されます。 (のらじろう) 2015/05/18(月) 08:52
追記です。 Call PostMessage(myhwnd, WM_COMMAND, 25, 0)
は、
Application.SendKeys "^A"
と同じ動きになります。 (のらじろう) 2015/05/18(月) 09:05
>Call PostMessage(myhwnd, WM_COMMAND, 25, 0)
この部分を削除して実行したら、前回と同じく選択範囲のみが 転記の対象になります。 (のらじろう) 2015/05/18(月) 09:20
>>メモ帳の全範囲を選択し、その次に「WM_COPY」で選択範囲をコピーしクリップボードに格納する
失礼しました。ここを読み飛ばしておりまして、前回と同じ要件を別方法で処理されたのかなと(コードも読まずに)早とちりしました。
(β) 2015/05/18(月) 12:54
今回の質問のコードに前回の質問時のコードからの変更点を書き込まなかったため 誤解を招くような書き方になってしまいました。
いまAPIでいろいろ情報を取得したりウィンドウを制御したりするのを勉強中です。 また質問させていただくことがあると思います。 その時はまたよろしくお願いいたします。 (のらじろう) 2015/05/18(月) 19:20
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.