• 締切済み

VBAでのタイトルバーの取得

vbaを使ってエクセルのセルのデータを起動済みの他のアプリケーション(以下他アプリ)に貼り付けたいと考えています。 具体的には、↓のようなものを作りたいと考えています。 Sub CopyCell()  Cells(2, 1).Copy  AppActivate ("タイトル")  SendKeys "^v", True End Sub そこで上記のようにAppActivateを使用して他アプリをアクティブにしようと思っています。しかし、AppActivateに必要になる、他アプリのウィンドウのタイトルがそのときどきによって変わる為、それに対処したいのですがなかなかうまくいかず困っています。 調べたところによると、API関数のGetWindowTextを使用すればそれが可能であるとのことでした。ただ、私は完全な初心者なのでAPIの使用方法や複数同時起動しているアプリケーションの中からアプリだけを選ぶ方法がまったくわかりません。 どなたかおわかりになる方いましたらよろしくお願い致します。 具体的なソースを貼って頂けると大変助かります。

みんなの回答

  • redfox63
  • ベストアンサー率71% (1325/1856)
回答No.1

GetWindowTextでタイトルバーの文字列は取得出来ますが このAPIにはウィンドウハンドルが必要です このハンドルを取得するには EnumWindowsなどを使って取得しないといけません EnumWindowsはコールバック関数を使ってユーザーアプリケーションにウィンドウハンドルを返してきます 標準モジュールに以下を記述します Declare Function EnumWindws lib "user32" _ (ByVal lpEnumFunc, ByVal lParam as Long) as Long Declare Function IsWindowVisible Lib "user32" _ (ByVal hWnd as Long) as Long Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _ (ByVal Hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Public ssMyTitle as String Function myProc(ByVal as hWnd as Long, byVal lParam as Long) as Long   ' 非表示のウィンドウ以外を検索する   if IsWindowVisible( hWnd ) then     Dim ss as String, nLen as Long     ss = String( 255, vbNullChar )     nLen = Len( ss )     if GetWindowText( hWnd, ss, nLen ) > 0 then       ' ここで目的のタイトルかどうかを判断       ' 条件が成立するなら0を返す       if Left(ss, 5) = "MyTest" then         ssMyTitle = ss         myProc = 0         Exit Function       end if     end if   end if   ' 次を探すためには1を返す   myProc = 1 End Function 呼び出し側は Sub Macro1()   ssMyTitle = ""   EnumWindows Addressof myProc, 0   if ssMyTitle <>"" then     Cells(2,1).Copy     AppActivate ssMyTitle     Sendkeys "^v", True   end if End Sub といった具合でしょう …

puriketu9
質問者

補足

具体的な内容で助かります。 大変申し訳ないんですが一つ条件を説明しそこねていました。 他アプリのタイトルは非常に把握しにくくなっています。 「0666 ABC          平成20年 処理済」 このような形式のタイトルで、ABCと平成の間のスペースの数を把握することができません。上述のタイトルで変わらないのは「平成」という部分だけです。 このマクロを使用する際、平成という文字を含むウインドウは他に使用しないので、タイトルが完全に一致していなくても、「平成」の文字をタイトルに含むウインドウに対してキーを送るようにできれば十分です。 このタイトルを把握しにくいという問題を解決するために考えている方法は現在2つあります。 ■直接appactivateにタイトル名を入れる方法 なんらかの方法で完全なタイトル名を取得し、それを手打ちで直接マクロに入れます。 たとえば、「タイトル123」のような完全な形でタイトルを把握し、appactivate("タイトル123")で直接指示するような形です。これができると非常に楽です。 ■教授していただいたような方法 平成の文字列をタイトルに含むウインドウに対してキーを送るような形式。 よろしくお願い致します。

関連するQ&A

  • VBAでエクセルの表をワードに入力

    Excel/Word2002使用です。 ワードへの入力を自動化するためにVBAを使用してエクセルの表をワードのテンプレートに渡したいのですが。 エクセルのA1:C8のセルに表として値が入力されています。 この表をコピーしてワードに貼り付けます。 ワード側は何も入力されていない文書ですが、 テンプレートが用意されているので、このテンプレートを指定してワードを立ち上げます。 ワードに貼り付けられる表はタブ区切りです。 具体的には下記コード3行目の”winword.exe”を具体的なテンプレートのパス名にしたいのですが・・・ Sub word貼り付け() Dim mytskID As Double Range("A1:C8").Copy  mytskID = Shell("winword.exe", vbNormalFocus)  Application.Wait Now + TimeValue("00:00:10")  Application.SendKeys "^v", True  Application.Wait Now + TimeValue("00:00:10")  Application.SendKeys "%fa", True  Range("A1").Copy  AppActivate mytskID  Application.SendKeys "^v", True  Application.SendKeys "~", True  Application.Wait Now + TimeValue("00:00:05")  Application.SendKeys "%fx", True  Application.CutCopyMode = False MsgBox "完了しました" End Sub なお、上記コードも教科書通りにしたはずなのですが、 何故か「名前をつけて保存」のSendKeys "%fa"のときだと思うのですが、 ワード側ではファイルメニューの罫線が反応してしまいます。 あわせてご教授いただければ幸いです。 よろしくお願いします。

  • エクセルVBAの値貼り付けについて

    いつもお世話になっております。 エクセルVBAについての質問ですが 以下のコードを使用するとどうしても元の書式の貼り付けになってします。 値(テキスト)貼り付けを実行したいのですがどこのコードをどのように変えればいいか教えてください。 ------------------------------------------------------------------------------------------- Sub IE_Open_Copy() Dim objIE As Object Const OLECMDID_SELECTALL = 17 Const OLECMDID_COPY = 12 Const OLECMDEXECOPT_DODEFAULT = 0 Const URL As String = "https://okwave.jp/question/" Set objIE = CreateObject("InternetExplorer.Application") With objIE .Visible = True .Navigate URL Do While .Busy DoEvents Loop Do Until .ReadyState = 4 DoEvents Loop .ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT .ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT Application.Wait Now() + TimeValue("00:00:05") .Quit End With AppActivate Application.Caption, True Range("A1").Select Application.Wait Now() + TimeValue("00:00:05") Application.SendKeys "^v" Set objIE = Nothing End Sub ---------------------------------------------------------------------------------------------

  • エクセルVBAで開いている他のアプリにデータ転記

    Sub TEST_Sendkey01() は、エクセルVBAでメモ帳を立ち上げ、データを転記するコードです。 期待通りに作動します。 http://okwave.jp/qa6760498.html Sub TEST_Sendkey01()   Dim App As String, tmp As String   Dim Ret, myAr   Dim i As Long, n As Long   App = "notepad.exe"   MsgBox App & "を実行します"   Ret = Shell(App, vbNormalFocus)   If Ret Then     AppActivate Ret, True   Else     MsgBox "失敗しました。"     Exit Sub   End If   myAr = Split("ABC101,BBB202,CCC303", ",")   For n = 1 To 2     For i = 0 To UBound(myAr)       SendKeys myAr(i)       SendKeys "{TAB}"       Application.Wait Time:=Now + TimeValue("00:00:01")     Next i     SendKeys "{ENTER}"   Next n   AppActivate Application.Name, False   MsgBox "終了しました。"   AppActivate Ret End Sub 質問は、あらたにメモ帳を立ち上げるのではなく、すでに開いている既存のメモ帳(TESTNOTE.txt)のデータに追加でデータを転記する方法です。 下記のようにしてみましたが、  AppActivate "TESTNOTEtxt - メモ帳" の段階で「実行時エラー5 プロシージャの呼び出し、または引数が不正です」となってしまいます。 どのように記述すればよいのでしょうか? Sub TEST_Sendkey02()   Dim myAr   Dim i As Long, n As Long   AppActivate "TESTNOTEtxt - メモ帳"      myAr = Split("D11,E22,F33", ",")   For n = 1 To 2     For i = 0 To UBound(myAr)       SendKeys myAr(i)       SendKeys "{TAB}"       Application.Wait Time:=Now + TimeValue("00:00:01")     Next i     SendKeys "{ENTER}"   Next n   AppActivate Application.Name, False   MsgBox "終了しました。"   AppActivate "TESTNOTEtxt - メモ帳" End Sub

  • タイトルバーのないアプリに二重起動防止機能を付けたい

    今、タイトルバーのないアプリを作っているのですが、このアプリのウインドウを別アプリから、APIのFindWindow関数で見つけたいのですが、タイトルがないのでクラス名でしか見つけれません。同じクラスのウインドウが他にもあった場合、区別が付かず困っています。 具体的に申しますと、作ったアプリに二重起動防止機能を付けたい(すでに起動されている場合はそのアプリのウインドウを元の大きさに戻してアクティブにする)のですが、そのアプリにはタイトルバーがなく、FindWindowでは見つけれない場合があります。 このような場合どうすればいいでしょうか? よろしくお願い致します。

  • VBAで、なぜかSendkeyが効きません。

    一年くらい前に作ったSendkeyを含んだマクロをまた使うことになりました。 再使用してみると、他のコードの部分は正常なのにSendkeyの部分だけが正常作動せず、空打ちしたように変化しないまま次のコードに移ります。 Excel2003使用ですが、Excel97の入った他のPCでやっても同じ現象が起こります。 そこで、テストにヘルプのSendkey例文をVBEに貼り付けてみましたが、やはりその部分だけ作業せず先へ進んでしまいます。 Sendkeyの行では、不適切なキーをキーボードから打った時によく鳴るビービーという音がPCから聞こえてきます。 自分が基本的な操作を1つ忘れているのじゃないかと思うのですが、それが何なのか見当が付きません。 なにかお気づきの点はないでしょうか? キーロガーを防止の為、ウィルスソフトがはねているのかと思いOFFにしてみましたが、関係ありませんでした。 テストした例文は下記です。 Sub x() Dim ReturnValue, I ReturnValue = Shell("CALC.EXE", 1) AppActivate ReturnValue For I = 1 To 20 SendKeys I & "{+}", True Next I SendKeys "=", True SendKeys "%{F4}", True End Sub

  • このソース

    APIなるものを初めて使ってプログラミングしているのですが、クラス化とか ウィンドウハンドルとか意味わからないです。 というわけでこのソースをきれいにできますか? (簡略してます。疑問は下の方にあります。) Private Sub XXX() Dim lngWindowHandleForeground As Long Dim strWindowText As String   Dim lngResult As Long ' アクティブなウィンドウのハンドルを取得 lngWindowHandleForeground = _ GetForegroundWindow() ' アクティブなウィンドウのタイトルを取得 lngResult = _ GetWindowText( _ lngWindowHandleForeground, _ strWindowText, _ Len(strWindowText)) ' アクティブなウィンドウのタイトルを表示 Label4.Caption = _    '※→納得いかないところ Left(strWindowText, _ InStr(strWindowText, _ vbNullChar) - 1) End Sub ウィンドウのタイトルを取得し別のサブルーチンで こんな書き方をしています。 AppActivate Label4.Caption つまりいちいちLabel4(しょうがないので作ったラベルです(^^ゞ)というラベルを仲介しないと引数が足りませんとエラーが出てしまいます。 理想としては AppActivate strWindowText もしくは   AppActivate lngResult  とできないんでしょうか? なぜこういう書き方ができないか教えてもらえると助かります。 賢い書き方があったら教えてください。よろしくお願いします。

  • VBAに関する質問

    VBA初心者のものですが、エクセル形式で保存されているいくつかのブックのシートの中身をテキストエディタ(MIFESというもの)に.csv形式で上から順に貼り付けていき保存するということは可能でしょうか? 例えば workbooks("wb1").worksheets("data").range("a1:f1")が 1  2 3  4  5 6  7 workbooks("wb2").worksheets("data").range("a1:f1")が 8 9 10 11 12 13 14 という2つのブックが存在するなら 1,2,3,4,5,6,7, 8,9,10,11,12,13,14, とテキストエディタにコピーしていく感じです。 イメージとして恐らく非常におかしなコードだと思いますが、 Sub test() Dim wb As Workbook Dim i As Integer, v As Integer Dim OpenFilename As String, wc As String dim ap as double i = Application.InputBox("コピーしたいファイル数を記入してください", Type:=1) ap = shell("MIW.exe") For v = 1 To i OpenFilename = Application.GetOpenFilename("Microsoft Excelブック,*.xls") Workbooks.Open Filename:=OpenFilename Set wb = ActiveWorkbook  wb.worksheets("data").range("a1:f1").copy appactivate ap sendkeys "^V", true appaplication,wait now+timevalue("0:00:05") appactivate application.caption application.cutcopymode = false next v end sub というような感じです。 最初、エクセルで一つのシートに対し貼り付け作業を行ったあと.csv形式で保存すればいいだろうと思っていたのですが、一つ一つのシートの容量が大きく、エクセルで処理できる容量をこえてしまいそのやり方では無理なようです。分かりにくいところなど多々あるとは思いますが、時間がございましたら、手助けとなるコードなり指摘なり示して頂ければと思います。宜しくお願いします。

  • VBAでスクリ-ンセーバーを起動させない方法

    会社のパソコンですが、スクリーンセーバーが設定されていて、一定時間がたつと自動的に起動します。 この設定は変更ができないようにされています。 今般、そのうちの一台に社内での案内用のデータを記載したエクセルのファイルを常時表示させようと思います。 そうなるとスクリーンセーバーがじゃまになります。 設定を解除できるとよいのですが、社内ルールで設定は変えられません。 しかたなく、人間が手でキーボード等を打ち込むかわりにマクロで画面を動かせばスクリーンセーバーは起動しないのではないかと考え、下記のコードを書いてみました。 Sub kidou() Call jikkou01 End Sub Sub jikkou01() Application.SendKeys "{PGDN}" Application.OnTime Now + TimeValue("00:00:10"), "jikkou02" End Sub Sub jikkou02() Application.SendKeys "{PGUP}" Application.OnTime Now + TimeValue("00:00:10"), "jikkou01" End Sub コードはちゃんと動くのですが、スクリーンセーバーはやはり立ち上がってしまいます。 なにかよい方法はないでしょうか?

  • エクセルVBA:マクロの中にマクロ?

    度々よろしくお願いします。ボタンが複数あって、それぞれに記録されたマクロの一部分が共通している場合の処理について教えてください。 例えば、前回の質問でご回答いただいたモノを流用し、別の処理と複合させたマクロがあります。 この変数ixがボタン(それぞれのマクロ)ごとに異なる場合、Do While以下を別のマクロとして記録し、それぞれのマクロの中で Application.Run "TEST.xls!Macro1"などのようにできるのでしょうか?変数の扱いをどうして良いのかわかりません。 Sub test() ~別の処理 ix = 8 Do While Cells(ix, "D") <> ""   Select Case Trim(Cells(ix, "D"))   Case "背筋"     Range("AZ8").Copy Destination:=Range(Cells(ix, "I"), Cells(ix, "AW"))   Case "アーム"     Range("BA8").Copy Destination:=Range(Cells(ix, "I"), Cells(ix, "AW"))   Case "レッグ"     Range("BB8").Copy Destination:=Range(Cells(ix, "I"), Cells(ix, "AW"))   End Select   Range(Cells(ix, "I"), Cells(ix, "AW")).Copy   Cells(ix, "I").PasteSpecial Paste:=xlPasteValues   ix = ix + 1 Loop Range("I8").Select End Sub

  • vba 2003のボタン実行がうまくいかない

    エクセルVBAについて質問があります。 使用環境はExcel2003~2010です。 フォームから実行をするとうまくいくのですが、 フォームのボタンに同じマクロを割り当てたものをクリックすると 2003ではとまってしまいます。 2010ではどちらも完結し、問題ありません。 止まるところまで中身を張り付けておきます。 Sub BookAndSheetCall() Dim Flag As Boolean Dim myPath As String, msg As String, shName As String Dim wb_A As Workbook, Sh As Worksheet myPath = "なんとかかんとか\Book1.xlsm" 'なんとかかんとかはネットワーク上です If myPath = "False" Then Exit Sub With Application Application.SendKeys ("{ESC}"), True Application.SendKeys ("{ENTER}"), True Application.SendKeys ("{NumLock}"), 1 End With Set wb_A = Workbooks.Open(myPath) 'ここでエラーがでてしまいます  shName = "Sheet1" Sheets("Sheet1").Select ActiveWindow.SelectedSheets.Visible = False wb_A.Worksheets(shName).Copy before:=ThisWorkbook.Sheets(1)     続く・・・ 止まる原因の手前にある「SendKeys」が悪さをしているような感じもするのですが、 Book1.xlsmにはパスワードが設定されているので、開くとパスワードを入力するメッセージが表示されるのですが、それを無視して続行するため、EscやEnterの入力が必要なので入れてます。 同じvbaで、なぜ2003のボタン実行だけがエラーでとまってしまうのでしょうか? お詳しい方、ご教授頂ければ幸いです。 ちなみに、私はvbaは初心者です。 色々参考にしながら、ここまで作っているというレベルです。 よろしくお願いします。

専門家に質問してみよう