Results of 1 - 1 of about 1215 for （Mook）
(0.001 sec.)
- [[20150326105138]]
- #score: 9211
- @digest: 8b34c578a4097a2d24362c51a716dda8
- @id: 67594
- @mdate: 2015-04-30T13:43:15Z
- @size: 24640
- @type: text/plain
- #keywords: strcap (110911), strcls (108818), selstrary (94731), enumwindowsproc (71403), genzai (61298), cntb (60299), txtoutput (51407), cbclr (48690), txtpath (45579), enumwindows (45251), newtxtpath (44799), cbstr (43825), getclassname (42926), folpath (41972), setforegroundwindow (39766), newtxtstr (39263), mycls (35834), getwindowtext (35010), ernum (34812), user32 (33573), emptyclipboard (32249), fnum (31757), declare (28948), openclipboard (28717), closeclipboard (28717), モ帳 (27728), txtstr (25127), lparam (22576), hwnd (18883), appactivate (16672), メモ (12776), sendkeys (12611)
- 『開いているメモ帳(複数)の選択範囲の文字列を取得』（のらじろう）
開いているメモ帳のドラッグで選択している範囲を取得するコードを書こうとしています。 ↓の過去ログ「開いているメモ帳の内容を取得する」でメモ帳の全範囲を取得する方法はわかりました。 http://www.excel.studio-kazu.jp/kw/20111206231619.html これを、ドラッグで選択している範囲、とするにはどう書き換えたらいいでしょうか? 開いているのが無題のメモ帳で、かつ、一つだけだったら AppActivate 〜 と SendKeys を使って出来そうなのですが、メモ帳が複数起動していると方法が分かりません。 ご指導お願いします。 ＜ 使用 Excel:Excel2007、使用 OS:WindowsVista ＞ ---- 開いているメモ帳全てのハンドルを得ることはできますが、範囲選択中かどうかまでは判らないような? とりあえず、片っ端からCTRL+Cを送ってはクリップボードを調べていく、という方法はどうですか? そんなプログラムが、何の役に立つか判りませんし、Excel VBAでやるような機能には思えませんが。 （普通のアプリは、他のアプリが何をやっているか、なんて、知ったことじゃないです） （???） 2015/03/26(木) 11:04 ---- 範囲選択されていれば、「編集」-「コピー」が選択可能になりますね。APIを駆使してこれを調べれば何とかなるかな。 APIは、自分で調べる能力がない人が使うべきではありませんので、あとはご自分で試行錯誤してください。 （???） 2015/03/26(木) 11:07 ---- もし複数のメモ帳が立ち上がっていて、その複数のメモ帳のいずれもがドラッグで選択している状態だったとしたら その中のどれを参照したいのですか? 目的がわかりません。 ドラッグしたものをエクセル側に取り込みたいのなら、ドラッグしっぱなしではなく、ドラッグして Ctrl/cをやって それを取り込めばいいのでは? メモ帳側でCtrl/c をやらない理由は何ですか? （β） 2015/03/26(木) 11:14 ---- 仮にこれを作ったとしていちいちメモ帳をドラッグしてVBA起動して貼り付けするのめんどうではありませんか メモ帳からデータを持ってきてVBAでいらないデータを削除したりする方が簡単だと思います。 （デイト） 2015/03/26(木) 11:24 ---- ちょこっと実験したところ、以下の方法で実現できそうです。 （1）一旦、全ての対象のhWndEditを調べて、配列に記憶。 （2）配列数分ループして、1つずつSetForegroundWindowしてはSendkeysでCTRL+Cを送った後、クリップボードのテキストを得る。 クリップボードのテキストを得るには、MSForms.DataObjectの.GetTextを使うと良いでしょう。 ハンドルを配列に格納するのは、1つのメモ帳をアクティブにすると次のFindWindowExの結果が変わってしまい、同じメモ帳を何度も調べてしまうのを防ぐためです。 また、AppActivateではなく、APIのSetForegroundWindowを使うのは、対象のメモ帳はExcelから起動したものではないためです。 範囲選択していないものを除外したい場合、更にアプリのメニュー文字列を調べるようなコーディングを追加してください。（かなり面倒） （???） 2015/03/26(木) 13:21 ---- >また、AppActivateではなく、APIのSetForegroundWindowを使うのは、対象のメモ帳はExcelから起動したものではないためです 自身が起動したものではなくても、キャプションを与えて、AppActivate はできますよね。 もっとも、今回の場合は、同じキャプションのメモ帳がたくさんあるので特定はできないわけですが。 Sub test() AppActivate "無題 - メモ帳", True End Sub （β） 2015/03/26(木) 13:52 ---- ???さん、βさん、デイトさん、ご回答ありがとうございます。 >もし複数のメモ帳が立ち上がっていて、その複数のメモ帳のいずれもがドラッグで選択している状態だったとしたら >その中のどれを参照したいのですか? ドラッグしたものはすべて参照します。 >ドラッグしたものをエクセル側に取り込みたいのなら、ドラッグしっぱなしではなく、ドラッグして Ctrl/cをやって >それを取り込めばいいのでは? >メモ帳側でCtrl/c をやらない理由は何ですか? Ctrl+Cですと、最後にコピーしたものしかクリップボードに残らないからです。 >メモ帳からデータを持ってきてVBAでいらないデータを削除したりする方が簡単だと思います。 全部コピーしてしまうと、どこをドラッグで選択したかを一々元のメモ帳を参照して確認する必要が出てきます。 まだ設計段階なのですが、複数の起動しているメモ帳の選択している範囲を個別に取得し、それを並び変えたり不要なものは 破棄、場合によってはさらに複写、最終的には一つのテキストファイルとして保存したりメールの本文に取込んでメール送信 したり、ということを考えています。 APIは初めてですが、ご教示いただきましたことを基に調べてみます。 必ず作り上げてご報告いたします。亀レスになると思いますが、長〜い目で見てやってください。よろしくお願いいたします。 （のらじろう） 2015/03/26(木) 23:47 ---- 健闘を祈ります。 API については FindWindowEx もいいと思いますが、EnumWindowsでクラス"NotePad" をすべて取得して実行する手もあるかと思います。 それより、運用を考えますと、(デイト)さんがリコメンドしておられる方式、必要なメモ帳を選択してすべてエクセルに取り込み 取り込んだシート上で、必要な文字列を指定しながら処理をするほうが、APIも不要で、コードもすっきりし また、処理、あるいはコードの柔軟性も増すような気がします。 （β） 2015/03/27(金) 07:04 ---- もし私がこの案件をやるとしたら、 対象のテキストファイルを指定して（フォルダ下のファイルをすべて?ファイルを個別に?）、 EXCEL にテキストボックスを挿入し、各ファイルごとにテキストを読み込みます。 （テキストはシートごと?シート内に順番に?） 各テキストボックス内で、範囲選択の変わりに選択した範囲の文字色を変更しておきます。 範囲指定（文字色変更）後、マクロ等で指定した範囲を一括処理します。 のような、ストーリーを考えるでしょうか。 単なる感想で、すみません。 （Mook） 2015/03/27(金) 16:24 ---- だいだいの使い方は判りましたし、メモ帳である点がミソですね。テキストデータなら何でも良いし、無題の状態でも、 そこに書いた文字さえあれば切り取れる、という事でしょう。 自動化することに関して、気になる点が。 メモ帳全てを列挙して、そこから選択範囲を抜き出して、結合して、1つのテキストにするわけですが、 抜き出す順番が不定になってしまうのです。かといって、ファイル名を利用しようにも、無題ならば、みな同じになるし…。 ハンドルの値なんて、windowsが勝手に振った番号であり、順不同だし。 順番がばらばらでも、使い物になるかが心配です。 私なら、ひとつ範囲選択する度にコピーし、まとめ用のメモ帳に貼り付けちゃいますね。 範囲選択+コピー、貼り付けまでで1セットです。ツール化する意味がないと思うのは、この順番のためです。 範囲選択した状態で次のメモ帳をクリックするとして、クリック場所を間違えて、選択状態を解除してしまうリスクもあります。 ただし、もう一歩使い方を進めて、例えば1つの切り取りを1つのテキストボックスとしてExcelに貼っていく機能と、 テキストボックスが並んでいる順番に内容を連結していって1つにする、という機能に分けても良いかもです。 テキストボックスを並べ替えるのは手動でもいい。Y座標の小さいものから順に処理すればいい。いかがでしょうか。 （???） 2015/03/27(金) 16:45 ---- 私も便乗してもしやることになったらどうするか考えました。 まず最初に考えたのがメモ帳をあきらめます。 テキストデータを貼り付けるなら別にメモ帳じゃなくてもいい ショートカットキーで次のテキストに行けるエディタで作れるようにします。 では例として、サクラエディタというテキストエディタを利用し事前に選択したデータを後ろから順番に貼り付けるというのをやります。 Sub text_Click() Dim ret As Variant Dim rc As Long rc = Shell("C:¥Program Files (x86)¥sakura¥sakura.exe", vbNormalFocus) AppActivate rc SendKeys "^{F4}", True SendKeys "^c", True SendKeys "^{F4}", True AppActivate "Microsoft Excel", False ThisWorkbook.Worksheets(1).Activate Range("a1").Select SendKeys "^v", True rc = Shell("C:¥Program Files (x86)¥sakura¥sakura.exe", vbNormalFocus) AppActivate rc SendKeys "^{F4}", True SendKeys "^c", True SendKeys "^{F4}", True AppActivate "Microsoft Excel", False ThisWorkbook.Worksheets(1).Activate Range("B1").Select SendKeys "^v", True End Sub 無理やり実現すると今の私はこうなります。私はほかの方と比べてまだVBAは浅いのでほかの方のを参考にした方がいいです。 （デイト） 2015/03/27(金) 17:45 ---- ???さん、βさん、デイトさん、Mookさん、ご回答ありがとうございます。 まだまだ継ぎ接ぎの状態ですが、ネットで調べて下記の状態まで出来ました。 便宜的に一つのメモ帳の選択範囲を一つのテキストファイルとして保存する 形にしてますが、これを基に一つづつテキストボックスに表示するなどの形 にする予定です。ここから先は上司と相談して作りこむことになります。 テキストボックスとリストボックスを連動させてテキストボックスの文字を 連結する順序を変える、という形になりそうです。 これで一応の完成です。ご指導いただきました回答者の方々、ありがとう ございました。 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 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 Dim CB As New DataObject Dim cnt As Long Dim ws As Worksheet Function EnumWindowsProc(ByVal hWnd As Long, lParam As Long) As Long Dim mycls As String Dim StrCap As String Dim StrCls As String StrCap = String(100, 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 ws.Cells(cnt, 1).Value = Left(StrCap, InStr(1, StrCap, Chr(0)) - 1) ws.Cells(cnt, 2).Value = Left(StrCls, InStr(1, StrCls, Chr(0)) - 1) ws.Cells(cnt, 3).Value = hWnd End If EnumWindowsProc = 1 End Function Sub SampleEnumWindows() Dim i As Integer Dim txtpath As String Dim cntb As Integer Dim genzai As String cnt = 1 Set ws = ThisWorkbook.Worksheets(1) Application.ScreenUpdating = False ws.Cells.Clear ws.Cells(cnt, 1).Value = "タイトル" ws.Cells(cnt, 2).Value = "クラス" Call EnumWindows(AddressOf EnumWindowsProc, 0) genzai = Format(Now, "yymmdd_hhmmss") cntb = 0 If ws.Cells(2, 3).Value <> "" Then For i = 2 To ws.Cells(Cells.Rows.Count, 3).End(xlUp).Row Call cbclr Call SetForegroundWindow(ws.Cells(i, 3).Value) SendKeys "^c" Sleep 50 Err.Clear On Error Resume Next With CB .GetFromClipboard cbstr = .GetText If Err.Number = -2147221404 Then Else cntb = cntb + 1 txtpath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "¥" & genzai & "_" & Format(cntb, "00") & ".txt" Sleep 50 Call TxtOutput(txtpath, CStr(cbstr)) End If End With On Error GoTo 0 Next i End If Application.ScreenUpdating = True End Sub Sub cbclr() If OpenClipboard(0) Then EmptyClipboard CloseClipboard End If End Sub 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/04/09(木) 10:08 ---- ちゃんと形になりましたね。もうちょっとだけデバッグでしょうか。 ・On Error でエラー検出する範囲は、狭い方が良いです。Err.Number を変数に代入しておけばいい。 ・SpecialFolders("Desktop")は、1回だけ実行すれば良い。ループで毎回得るのは無駄なので、変数に代入しましょう。 （変わるのはファイル名部分だけですよね） 特に On Error のせいで、 以下に問題が出ると、予想外の結果になります。 （このサブプロシジャを目的のシートモジュール以外に置いた場合、Cells.Rows.Countはシートを特定していないためエラーなのに、無視するため） For i = 2 To ws.Cells(Cells.Rows.Count, 3).End(xlUp).Row あと、試しに動かしてみたところ、複数のテキストファイルが同じ内容になる現象が出ました。 私が2回目に指摘したことが発生するようです。 （ハンドルを得るのと、テキストを得るのを、別のループにすれば良いはず） （???） 2015/04/09(木) 11:45 ---- ご指導いただきました点を修正してみました。 起動しているメモ帳一覧をセル転記から配列格納に変更、文字列が選択されている メモ帳 のタイトル、選択内容を配列格納、としてみました。 私の方で8つほどメモ帳を立ち上げ、そのうちの5つほどメモ帳の文字列を選択した 状態で実行したら一応はうまくいっているようです。 もしお気づきの点がございましたらご指摘ください。 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 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 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(100, 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 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 newfol As String ernum = -2147221404 genzai = Format(Now, "yymmdd_hhmmss") folpath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "¥" & genzai MkDir (folpath) cnt = -1 Call EnumWindows(AddressOf EnumWindowsProc, 0) If cnt <> -1 Then cntb = -1 For i = 0 To cnt Call cbclr Call SetForegroundWindow(ary(0, i)) SendKeys "^c" Sleep 50 Err.Clear cbstr = "" With CB On Error Resume Next .GetFromClipboard cbstr = .GetText End With If Err.Number = ernum Then Else cntb = cntb + 1 ReDim Preserve selstrary(1, cntb) selstrary(0, cntb) = cbstr selstrary(1, cntb) = ary(1, i) End If On Error GoTo 0 Next i If cntb <> -1 Then For i = 0 To cntb txtpath = folpath & "¥" & genzai & "_" & 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/04/09(木) 21:00 ---- 保存対象メモ帳がないのにフォルダが作成される、無題メモ帳が複数ある場合にテキストファイルのパスが重複してしまう、という不具合がありましたので 修正しました。 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 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 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(100, 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 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 Call cbclr Call SetForegroundWindow(ary(0, i)) SendKeys "^c" Sleep 50 Err.Clear cbstr = "" With CB On Error Resume Next .GetFromClipboard cbstr = .GetText 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 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/04/09(木) 22:45 ---- >Function EnumWindowsProc(ByVal hWnd As Long, lParam As Long) As Long ここの >StrCap = String(100, Chr(0)) を StrCap = String(255, Chr(0)) に変えた方がいいようです。 100だと、タイトルを取得するとき、長いタイトルだと途中までしか取得できませんでした。 今のところ、私の環境では100だと不十分でしたが255で十分でした。 （のらじろう） 2015/04/10(金) 21:02 ---- メモ帳のウィンドウのTopが高い(小さい)順に選択内容を結合、としてみました。 これと、もう一つは、 リストボックスに格納しスピンボタンでリストボックスの二つの行を前後入れ替え、 その順でテキストボックスに結合した内容を表示(テキストボックスは手動で編集もできる)、テキスト ボックスの内容をテキストファイル保存 というものです。こちらはコードアップは省略させていただきます。 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 EnumWindows Lib "user32.dll" ( _ ByVal lpEnumFunc As Long, _ 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 Declare Function GetWindowRect Lib "user32.dll" ( _ ByVal hWnd As Long, _ lpRect As RECT _ ) As Long Declare Function GetClientRect Lib "user32.dll" ( _ ByVal hWnd As Long, _ lpRect As RECT _ ) As Long Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Dim CB As New DataObject Dim mydic As Object 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 hwndtp As Single Dim wRECT As RECT Dim ky As Variant Dim sp As Variant Dim i As Integer Dim j As Integer Dim txtpath As String Dim txtstr As String Dim genzai As String Dim ernum As Long Dim cbstr As String Dim cntb As Integer Dim folpath As String Set mydic = CreateObject("Scripting.Dictionary") ernum = -2147221404 genzai = Format(Now, "yymmdd_hhmmss") txtpath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "¥" & genzai & ".txt" cnt = -1 Call EnumWindows(AddressOf EnumWindowsProc, 0) For i = 0 To cnt Call GetWindowRect(ary(0, i), wRECT) hwndtp = wRECT.Top If mydic.exists(hwndtp) Then mydic.Item(hwndtp) = mydic.Item(hwndtp) & vbCrLf & ary(0, i) Else mydic.Add hwndtp, ary(0, i) End If Next i If mydic.Count <> 0 Then txtstr = "" For i = 1 To mydic.Count ky = WorksheetFunction.Small(mydic.keys, i) sp = Split(mydic.Item(ky), vbCrLf) For j = 0 To UBound(sp) Call cbclr Call SetForegroundWindow(sp(j)) SendKeys "^c" Sleep 50 Err.Clear cbstr = "" With CB On Error Resume Next .GetFromClipboard cbstr = .GetText End With If Err.Number = ernum Then Else If txtstr <> "" Then txtstr = txtstr & vbCrLf txtstr = txtstr & cbstr End If On Error GoTo 0 Next j Erase sp Next i End If If txtstr <> "" Then Call TxtOutput(txtpath, txtstr) 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/04/30(木) 22:43... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201503/20150326105138.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97012 documents and 608126 words.
訪問者：