Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


2402 / 13645 ツリー ←次へ | 前へ→

【68181】InputBoxメソッドのD.Box位置について あまがえる 11/2/10(木) 10:33 質問[未読]
【68184】Re:InputBoxメソッドのD.Box位置について Yuki 11/2/11(金) 11:06 発言[未読]
【68185】Re:InputBoxメソッドのD.Box位置について Yuki 11/2/11(金) 11:10 発言[未読]
【68187】Re:InputBoxメソッドのD.Box位置について あまがえる 11/2/11(金) 18:20 お礼[未読]
【68188】Re:InputBoxメソッドのD.Box位置について kanabun 11/2/11(金) 19:29 発言[未読]
【68192】Re:InputBoxメソッドのD.Box位置について あまがえる 11/2/12(土) 4:55 お礼[未読]
【68193】Re:InputBoxメソッドのD.Box位置について kanabun 11/2/12(土) 10:45 発言[未読]
【68194】Re:InputBoxメソッドのD.Box位置について とおりすがり 11/2/12(土) 10:47 回答[未読]
【68195】Re:InputBoxメソッドのD.Box位置について あまがえる 11/2/13(日) 8:40 お礼[未読]
【68196】Re:InputBoxメソッドのD.Box位置について UO3 11/2/13(日) 12:19 発言[未読]
【68197】Re:InputBoxメソッドのD.Box位置について grok 11/2/13(日) 14:49 発言[未読]
【68200】Re:InputBoxメソッドのD.Box位置について grok 11/2/13(日) 17:18 発言[未読]
【68201】Re:InputBoxメソッドのD.Box位置について ichinose 11/2/13(日) 23:28 発言[未読]
【68202】Re:InputBoxメソッドのD.Box位置について UO3 11/2/14(月) 9:16 発言[未読]
【68206】Re:InputBoxメソッドのD.Box位置について ichinose 11/2/14(月) 21:17 発言[未読]
【68207】Re:InputBoxメソッドのD.Box位置について grok 11/2/14(月) 22:10 発言[未読]
【68208】Re:InputBoxメソッドのD.Box位置について UO3 11/2/15(火) 0:46 発言[未読]
【68210】Re:InputBoxメソッドのD.Box位置について ichinose 11/2/15(火) 6:11 発言[未読]
【68211】Re:InputBoxメソッドのD.Box位置について UO3 11/2/15(火) 6:34 発言[未読]
【68212】Re:InputBoxメソッドのD.Box位置について よろずや 11/2/15(火) 6:48 発言[未読]
【68213】Re:InputBoxメソッドのD.Box位置について UO3 11/2/15(火) 9:27 発言[未読]
【68225】Re:InputBoxメソッドのD.Box位置について ichinose 11/2/15(火) 23:57 発言[未読]
【68249】Re:InputBoxメソッドのD.Box位置について あまがえる 11/2/17(木) 14:15 お礼[未読]

【68181】InputBoxメソッドのD.Box位置について
質問  あまがえる  - 11/2/10(木) 10:33 -

引用なし
パスワード
   はじめて質問させていただきます。
Excelで納品書作成や技術計算を行うマクロを組んでいます。
ExcelやAccessの機能にあるプルダウンボックスでリストのデータを呼び出すような操作と同様のプロセスを、ワークシート上のリストに実際に飛んでから選択し、コピペで目的のシートに持ってきて実現するプロシージャを利用しています。
つまり目的の計算をする場であるSheet1から実行してSheet2に用意されているリストにフォーカスが移って「待ち」になり、ユーザが該当データを選択すれば再実行されてSheet1の元の位置にコピペで持ってくるという初歩的なものです。
Excelで用意されているプルダウンボックス機能を利用するのに比べて、呼び出すデータの多くのフィールドやレコードを一度に確認できるので多用しておりまして、私としてはたいへん重宝しています。

このプロシージャの中の中核的なコードは

Set obj = Application.InputBox(prompt:="該当のdataを選んでちょうだい!",Left:=-10000, Top:=0, Type:=8)

であり、変数「obj」に選択したいデータ行のRangeオブジェクトを代入して、その変数の行番号を取得し、コピーするデータ範囲を決定することにしています。

ここでLeft:=-10000とあるのは、選択元のシート上該当データを探す際にInputBoxメソッドのダイアログボックス自体が邪魔なためであり、画面の表示範囲外にダイアログボックスの位置を指定することで実質的な非表示とし、選択元シート上に表示される破線(非表示ダイアログボックス上のコントロールと連動)のみで選択位置を確認してEnterキー実行し、変数「obj」に目的セルのオブジェクトを代入しています。

さて、Excel2003まではこのコードで問題なく目的の動作を実現できていましたが、2007以降になってLeft:=-10000が無効になり困っています。
つまりleftの数値に関わらず、画面の同じ中央付近の位置にダイアログボックスがずでんと現れてしまうのです。
現在2010の環境がありますので、InputBoxメソッドのTopやLeftに様々な数値を代入して実行してもダイアログボックスの位置はまったく変化がありません。
何か記載方法など2007以降は変化があるのでしょうか?

なお、Excel2010ヘルプのApplication.InputBoxメソッドの項に下記の記述があることは確認しています。

****************************
Left オプション バリアント型 (Variant) 画面の左上隅を基準として、ダイアログ ボックスの X 座標をポイント (ポイント: 印刷する文字のサイズ (高さ) を指定する基本単位。1 ポイントは、約 0.0353 cm (1/72 インチ) です。)単位で指定します。
Top オプション バリアント型 (Variant) 画面の左上隅を基準として、ダイアログ ボックスの Y 座標をポイント単位で指定します。
****************************

InputBox関数のxpos,yposは有効なのですが、こちらはオブジェクトを扱えないので、セル番地を手入力する必要が出てくると思われ、目的の機能を実現できないと考えています。

以上の観点からInputBoxメソッドのダイアログボックスの位置の操作方法についてご教示いただければ幸いです。よろしくお願いいたします。

【68184】Re:InputBoxメソッドのD.Box位置について
発言  Yuki  - 11/2/11(金) 11:06 -

引用なし
パスワード
   ▼あまがえる さん:
>このプロシージャの中の中核的なコードは
>
>Set obj = Application.InputBox(prompt:="該当のdataを選んでちょうだい!",Left:=-10000, Top:=0, Type:=8)
>
>であり、変数「obj」に選択したいデータ行のRangeオブジェクトを代入して、その変数の行番号を取得し、コピーするデータ範囲を決定することにしています。
>
>ここでLeft:=-10000とあるのは、選択元のシート上該当データを探す際にInputBoxメソッドのダイアログボックス自体が邪魔なためであり、画面の表示範囲外にダイアログボックスの位置を指定することで実質的な非表示とし、選択元シート上に表示される破線(非表示ダイアログボックス上のコントロールと連動)のみで選択位置を確認してEnterキー実行し、変数「obj」に目的セルのオブジェクトを代入しています。
>
>さて、Excel2003まではこのコードで問題なく目的の動作を実現できていましたが、2007以降になってLeft:=-10000が無効になり困っています。
>つまりleftの数値に関わらず、画面の同じ中央付近の位置にダイアログボックスがずでんと現れてしまうのです。
>以上の観点からInputBoxメソッドのダイアログボックスの位置の操作方法についてご教示いただければ幸いです。よろしくお願いいたします。

面倒ですが下記の方法で実現できそうですが、取り扱いには注意してください。
Option Explicit
Private Declare Function GetClassName Lib "user32.dll" _
              Alias "GetClassNameA" _
              (ByVal hwnd As Long, _
              ByVal lpClassName As String, _
              ByVal nMaxCount As Long) As Long

Private Declare Function GetCurrentThreadId Lib "kernel32.dll" _
              () As Long
' フックプロシージャ関係
Private Declare Function SetWindowsHookEx Lib "user32.dll" _
              Alias "SetWindowsHookExA" _
              (ByVal idHook As Long, _
              ByVal lpfn As Long, _
              ByVal hmod As Long, _
              ByVal dwThreadId As Long) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32.dll" _
              (ByVal hHook As Long) As Long

Private Declare Function CallNextHookEx Lib "user32" _
              (ByVal hHook As Long, _
              ByVal ncode As Long, _
              ByVal wParam As Long, _
              ByVal lParam As Long) As Long

Private Const WH_CBT = 5
Private Const HCBT_DESTROYWND = 4
Private Const HCBT_ACTIVATE = 5

'サブクラス化関係
Private Declare Function GetWindowLong Lib "user32" _
              Alias "GetWindowLongA" _
              (ByVal hwnd As Long, _
              ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib "user32" _
              Alias "SetWindowLongA" _
              (ByVal hwnd As Long, _
              ByVal nIndex As Long, _
              ByVal dwNewLong As Long) As Long
              
Private Declare Function SetWindowPos Lib "user32.dll" _
              (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 uFlags As Long) As Long

Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOACTIVATE = &H10

Private hHookProc  As Long 'フックのハンドル
Private lngLeft   As Long
Private lngTop   As Long

' CBTフックプロシージャ
Private Function CBTProc(ByVal ncode As Long, _
             ByVal wParam As Long, _
             ByVal lParam As Long) As Long
  Dim lngRtn   As Long
  Dim strClass  As String
  Dim lngWLong  As Long
  Dim thWnd    As Long
  Dim lngCtlID  As Long
  Const Asterisk = 42
  
  Select Case ncode
    Case HCBT_ACTIVATE
      strClass = String$(13, 0)
      GetClassName wParam, strClass, Len(strClass)
      If StrComp(strClass, "bosa_sdm_XL9" & vbNullChar, vbBinaryCompare) = 0 Then
        ' InputBoxを表示
        lngRtn = SetWindowPos(wParam, _
                   0, _
                   lngLeft, _
                   lngTop, _
                   0, _
                   0, _
                   SWP_NOSIZE Or _
                   SWP_NOZORDER Or _
                   SWP_NOACTIVATE)
      End If
    Case HCBT_DESTROYWND
    Case Is < 0                   '次のフック
      CBTProc = CallNextHookEx(hHookProc, ncode, wParam, lParam)
      Exit Function
  End Select
  CBTProc = 0
End Function

Public Function AppInputBox(Prompt As String, _
              Optional Title, _
              Optional Default, _
              Optional Left, Optional Top, _
              Optional HelpFile, _
              Optional HelpContextID, _
              Optional objType) As Variant
  Dim lngRtn As Long
  On Error GoTo InputBox_Close
  'フックを設定
  hHookProc = SetWindowsHookEx(WH_CBT, _
                 AddressOf CBTProc, _
                 0, _
                 GetCurrentThreadId())
  ' InputBoxを表示
  Set AppInputBox = Application.InputBox(Prompt, Title, Default, Left, Top, HelpFile, HelpContextID, objType)
InputBox_Close:
  'フックを解除
  lngRtn = UnhookWindowsHookEx(hHookProc)
End Function

' ↓を実行        
Sub InputDisp()
  Dim rng
  
  lngLeft = -10000
  lngTop = 0
  Set rng = AppInputBox("該当のdataを選んでちょうだい!", , , , , , , 8)
  Debug.Print rng.Address
End Sub

【68185】Re:InputBoxメソッドのD.Box位置について
発言  Yuki  - 11/2/11(金) 11:10 -

引用なし
パスワード
   ▼あまがえる さん:
' CBTフックプロシージャ
Private Function CBTProc(ByVal ncode As Long, _
             ByVal wParam As Long, _
             ByVal lParam As Long) As Long
  Dim lngRtn   As Long
  Dim strClass  As String
' 以下宣言不要です。
  Dim lngWLong  As Long
  Dim thWnd    As Long
  Dim lngCtlID  As Long
  Const Asterisk = 42

【68187】Re:InputBoxメソッドのD.Box位置について
お礼  あまがえる  - 11/2/11(金) 18:20 -

引用なし
パスワード
   Yukiさま

たいへんご丁寧なレスをつけていただき、感謝です。
当方、プログラム言語はVBAをいじったことがあるだけ、基本的にわがスキルは極めて初歩的なものですから、「Declare」ステートメントや「フック」の処理を初めてまのあたりにし、少々びっくりしました。
判らないながらも拝見していくと、つまるところVBAのレベルではないが、OSのDLLの機能を呼び出して処理する方法が考えられる、というアドバイスだと理解しました(それでよろしいでしょうか?)
「取扱い注意」というご指摘のとおり、残念ですが私としては少々敷居の高い処理です。

VBAの枠組みの中でInputBoxメソッドのオプションとしてLeftやTopは設定されています。
私はOSやVBA等の関係をよく理解しているわけではないものですから、的確な疑問かどうかわかりませんが、Excel2007以後のバージョンで同2003以前と同様の動作ができないという問題を回避する方法はVBAの中にはないのでしょうか?

【68188】Re:InputBoxメソッドのD.Box位置について
発言  kanabun  - 11/2/11(金) 19:29 -

引用なし
パスワード
   ▼あまがえる さん:
こんにちは〜

言われてはじめて気が付きましたが、
> Excel2007以後のバージョンで同2003以前と同様の動作ができないという問題

よくまぁ、こんな不具合がほったらかしにされてきたもんですね?
XL2007の改良版である XL2010でもなおってないですね。

ただ、ぼくのXL2010では
LeftやTopパラメータを指定しないと、InputBoxは画面の左上に近いところに
出現します。
Left:=0, Top:=0 とセットしたかのような位置に、です。
この位置はタイトルバーや リボンがある位置なので、
実務的にはセル選択するのに支障はないような気がしますけど、
いかがですか?

【68192】Re:InputBoxメソッドのD.Box位置について
お礼  あまがえる  - 11/2/12(土) 4:55 -

引用なし
パスワード
   kanabunさま

コメントありがとうございます。やはりバグなのでしょうか。

ご教示いただいた方法、XL2010、XL2003にて下記4つの記載法で私も試してみました。

****************************
Set obj = Application.InputBox(prompt:="該当のdataを選んでちょうだい!", Type:=8)

Set obj = Application.InputBox("該当のdataを選んでちょうだい!", , , , , , , 8)

Set obj = Application.InputBox(prompt:="該当のdataを選んでちょうだい!", Left:=0, Top:=0, Type:=8)

Set obj = Application.InputBox("該当のdataを選んでちょうだい!", , , 0, 0, , , 8)
****************************

上記4コード、いずれも画面中央付近に表示されXL2010ではLeft:=-10000と指定したものも含めまったく同じ位置に表示されます。
画面の左上隅が基準とのことですので、そこに表示されてよさそうなものですが、XL2003も含め画面ほぼ中央に表示されます。どーもよくわかりません。

kanabunさまと同じXL2010も同様なわけですが、何が違うんでしょうか・・・。OSは2003がWinXP HomeEditionSP3、2010がWin7 Home Premiumです。

私ごとの書き込みを許していただければ、このコードは、自分の作業用のマクロの一部として長年使ってきたものです。しかし、一昨年来本業で作った野菜を地元給食センターに納品する際の、納品書作成・出荷記録マクロの一部としても仲間に使ってもらっていて、昨年XL2007のユーザーが発生したことから不具合が発覚しました。
自分もようやく2010を手に入れ検証することができるようになったので今回の質問アップということになった次第です。
Excelの様々なバージョン混在で利用している状態ですので、バグならばそれはしょうがないとしても、なにか使い勝手を改善できる方法を手助けいただけれるとすればたいへんありがたいです。
左上隅にきちんと表示されて、XL2003以前のユーザーでもそれほど邪魔でない、というのならばいいのですが・・・。

【68193】Re:InputBoxメソッドのD.Box位置について
発言  kanabun  - 11/2/12(土) 10:45 -

引用なし
パスワード
   ▼あまがえる さん:

>kanabunさまと同じXL2010も同様なわけですが、何が違うんでしょうか・・・。OSは2003がWinXP HomeEditionSP3、2010がWin7 Home Premiumです。
>
ぼくは1つのPCにバージョンのちがう5つのExcelをインストールしてまして、
[OSはWin7 Pro]、それで検証すると、XL2003ではLeft,Topパラメータ有効、
XL2010ですと、パラメータが無視されScreen左上にBoxが表示される、という
現象になりました。(ちなみにXL2007 では、同じくパラメータは無視され、
画面のほぼ中央にInpuBoxが現れました)


>左上隅にきちんと表示されて、XL2003以前のユーザーでもそれほど邪魔でない、というのならばいいのですが・・・。

Yukiさんのプロシージャをありがたく利用させてもらったらどうですか?
ぼくも CBTフックとか中身の詳しいことは分からないけど、それを利用すれば
バージョンの違いによるApplication.InputBoxの挙動の違いが解消されるとい
うのであれば、利用させていただかない手はないと思います。

【68194】Re:InputBoxメソッドのD.Box位置について
回答  とおりすがり  - 11/2/12(土) 10:47 -

引用なし
パスワード
   SendKeys "% M"
SendKeys "{Left 50}{ENTER}"
Set obj = Application.InputBox(prompt:="該当のdataを選んでちょうだい!", Type:=8)

とか。

【68195】Re:InputBoxメソッドのD.Box位置について
お礼  あまがえる  - 11/2/13(日) 8:40 -

引用なし
パスワード
   kanabunさま
とおりすがりさま
コメントありがとうございます。

kanabunさま

XL2003ではLeft,Topパラメータ有効というのは同じですが、両値"0"の場合、ヘルプでの説明と異なりこちらの2003では画面中央付近が表示位置になります。
XL2010ですと、同じくパラメータが無視されるのですが、詳しく調べてみると、直前にBoxが表示された位置に表示されるようです。つまりマウス等でBoxをドラッグ移動すると次の表示位置はそこになる、という具合でした。
そうであるならばあらかじめマウスでBox位置を邪魔のない位置にドラッグしておく、という対策も考えられますが、複数ユーザーでの汎用性に難ありと考えています。

> Yukiさんのプロシージャをありがたく利用させてもらったらどうですか?
そういうお考えもあるかと思います。ありがとうございます。

とおりすがりさま

> SendKeys "% M"
> SendKeys "{Left 50}{ENTER}"
> Set obj = Application.InputBox(prompt:="該当のdataを選んでちょうだい!", Type:=8)

いや、びっくりしました。こういう手もあるんですね。
すばらしくシンプルに望む動作が実現できて感動しました!

よろしければひとつ教えていただきたいと思います。
マクロではなく、Windowメニューの「移動」を選択すればアクティブのWindowが矢印キーでの移動の対象になります。
ご教示いただいたSendkeysがInputBoxの後に実行されれば、InputBoxが移動するだけですが、InputBoxの前に実行しているのにActiveWindowではなく後に表示されるInputBoxの位置が対象になるというのはどういう理屈なのでしょうか?
事実、ご教示のマクロをステップ実行するとうまく動作しません。不思議です。

【68196】Re:InputBoxメソッドのD.Box位置について
発言  UO3  - 11/2/13(日) 12:19 -

引用なし
パスワード
   ▼あまがえる さん:

よこから失礼します。
とおりすがりさんの方法、いいものを見せていただきました。
眼福です。

ところで

>事実、ご教示のマクロをステップ実行するとうまく動作しません。不思議です。

ステップ実行ということはVBE 画面が表示されていますよね。
したがって SendKeysで送られる〔信号〕はエクセルシート画面ではなく
VBE画面に対して作用するということなんだろうと思います。

【68197】Re:InputBoxメソッドのD.Box位置について
発言  grok  - 11/2/13(日) 14:49 -

引用なし
パスワード
   みなさんこんにちは。

SendKeysは、NumLockが解除されるといった不具合が多数報告されています。

ユーザーから「数字の入力が出来ないんだけど」といった声があちこちから
聞こえてくるのが想像できます。

私は不具合を体験してからSendKeysの使用をやめました。NumLock解除の回避
方法はありません。sendkeysをやめるか替わりにAPIのkeybd_eventを使用する
方法がよく紹介されていますが、ちょっと違うアプローチで、

タイマーを使ってInputBox表示後に位置を移動する方法を紹介したいと思います。


Public Declare Function SetTimer Lib "user32" _
           (ByVal hwnd As Long, _
            ByVal nIDEvent As Long, _
            ByVal uElapse As Long, _
            ByVal lpTimerFunc As Long) As Long
                       
Public Declare Function KillTimer Lib "user32" _
           (ByVal hwnd As Long, _
            ByVal nIDEvent As Long) As Long

Public Declare Function MoveWindow Lib "user32" _
           (ByVal hwnd As Long, _
            ByVal X As Long, _
            ByVal Y As Long, _
            ByVal nWidth As Long, _
            ByVal nHight As Long, _
            ByVal bRepain As Long) As Long
                        
Public Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
           (ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long
Public Declare Function GetForegroundWindow Lib "user32.dll" () As Long
Public Declare Function GetWindowRect Lib "user32.dll" _
           (ByVal hwnd As Long, lpRect As RECT) As Long

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

Sub Test()

  Dim obj
  '0.3秒後にTimerを発動してInputBoxの位置を移動します。
  SetTimer 0&, 0&, 300, AddressOf myTimer
  Set obj = Application.InputBox _
        (prompt:="該当のdataを選んでちょうだい!", Type:=8)
  
End Sub


Private Function myTimer(ByVal hwnd As Long, _
             ByVal uMsg As Long, _
             ByVal idEvent As Long, _
             ByVal SysTime As Long) As Long

  
  Dim Targethwnd&
  Dim myRect As RECT
  Dim ret&
  
  '※このFunction内にブレークポイントを設置しない事!!ecxelが落ちます。
  '値を確認するにはDebug.Printの使用


  'Timer中のエラーは、無視をするか正しくエラーをハンドルしなければ
  'Excelが落ちます。要注意です。
  On Error Resume Next
  
  'フォアグランドにあるウインドウハンドルを取得します。
  Targethwnd = GetForegroundWindow()
  
  'InputBoxのウインドウハンドルが取得できたら
  If Targethwnd <> 0 Then
    
    'myRectにInputBoxのサイズと位置を格納します。
    ret = GetWindowRect(Targethwnd, myRect)
    
     If ret <> 0 Then 'Rectが取得できたら
    
      With myRect
         'InputBoxの動かす前の位置を取りあえず書き出してみます。
         Debug.Print "Left=" & .Left, "top=" & .Top, _
               "right=" & .Right, "bottom=" & .Bottom

         'API movewindowでInputBoxを移動します。

         MoveWindow Targethwnd, -(.Right - .Left), .Top, _
              .Right - .Left, .Bottom - .Top, 1&

         '-(.Right - .Left)の値だと画面によっては、
         'InputBoxのおしりが見えるはずです。
         '-(.Right - .Left)の部分を直接-10000など大きい数字でも
         'OKです。
      End With
     End If
      
  End If
  
  KillTimer 0&, idEvent '必ずTimerを解除します。
  

End Function

【68200】Re:InputBoxメソッドのD.Box位置について
発言  grok  - 11/2/13(日) 17:18 -

引用なし
パスワード
   ちょっと補足です。

左上に表示するなら
MoveWindow Targethwnd, 0, 0, .Right - .Left, .Bottom - .Top, 1&
X=0,Y=0です。


とおりすがりさんのコードを4,5回実行しただけでも、NumLockが切れて
しまいました。(^^)

参考になれば。

【68201】Re:InputBoxメソッドのD.Box位置について
発言  ichinose  - 11/2/13(日) 23:28 -

引用なし
パスワード
   こんばんは。

私も仕事では、殆どSendkeysは使いません。


>InputBoxの前に実行しているのにActiveWindowではなく後に表示されるInputBoxの位置が対象になるというのはどういう理屈なのでしょうか?

Sendkeysが直ちに実行される命令ではないからでしょうねえ!!
試しに以下のコード、実行する前に想像してください。
セルA1は、結果どうなると思いますか?

あまがえるさんは、123が表示される という理屈ですよね?
実行してみてください。
Sub test1()
  Range("a1").Select
  SendKeys "abc{ENTER}"
  Range("a1").value = 123
End Sub

abcが入っていませんか?


APIが嫌なら、ユーザーフォームにRefeditコントロールを貼り付けて
自作してしまう方法は、どうでしょうか?

新規ブックにて試してみてください。


ユーザーフォームを一つ作成してください(UserForm1)。

このUserForm1には、Refeditコントロールだけを配置してください(RefEdit1)。
詳細は、

www.excel-vba.net/excel-userform-016.html

この辺りを参考にしてください。


UserForm1のモジュールに

'=============================================================
Option Explicit
Public value As Variant
Private Sub RefEdit1_KeyDown(KeyCode As Integer, ByVal Shift As Integer)
  If KeyCode = 13 Then
    value = RefEdit1.value
    RefEdit1.Visible = False
    Me.Hide
  End If
End Sub
Private Sub UserForm_Activate()
  With Me
    .Left = 40000
    .Top = 40000
  End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  If CloseMode = 0 Then
    Cancel = True
  End If
End Sub


標準モジュールに

'==================================================================
Sub test()
  Dim add As String
  With UserForm1
    .Show
    add = .value
  End With
  Unload UserForm1
  On Error Resume Next
  With Application
    add = .ConvertFormula(add, xlR1C1, xlA1)
    .Goto .Range(add)
  End With
  On Error GoTo 0
End Sub

これでtestを実行してみてください。

セル範囲の指定が可能になります。指定したセル範囲は、破線で囲まれます。

エンターキーで確定され、指定範囲が選択されます。

リンク先にもありますが、RefEditには、バグがあります。
ここを参考にバグを避けて使ったつもりです。
www.h3.dion.ne.jp/~sakatsu/Excel_Tips08.htm#S7
Excel2002で簡単なテストでは作動しています。
2010で試してみてください。

【68202】Re:InputBoxメソッドのD.Box位置について
発言  UO3  - 11/2/14(月) 9:16 -

引用なし
パスワード
   ▼ichinose さん:

失礼します。

>Sendkeysが直ちに実行される命令ではないからでしょうねえ!!

これは、そのとおりだと思います。
仮にSendKeysがすばやく実行されたとしても、その信号を受け取る部分が
遅れるかもしれませんしね。私も使う場合は、それでプロシジャがおわるような
使い方、End Subの直前におくばあいのみですね。

ところで、ご提示のTest1ですが、私の環境では、いまのところ何度実行しても
123 が入ります。

なので、保証の限りではないということだろうと理解しています。

【68206】Re:InputBoxメソッドのD.Box位置について
発言  ichinose  - 11/2/14(月) 21:17 -

引用なし
パスワード
   こんばんは。


>ところで、ご提示のTest1ですが、私の環境では、いまのところ何度実行しても
>123 が入ります。
>
>なので、保証の限りではないということだろうと理解しています。
そうなんですねえ・・・。

因みにExcelバージョンやWinバージョンを教えてください。
私のは、Win2000&Excel2002での結果です。

Sub test1()
  Dim g0 As Long
  Range("a1").Select
  SendKeys "abc{ENTER}"
  For g0 = 1 To 1000
   Range("a1").Value = Range("a1").Value + 1
  Next
End Sub

これでも同じなんですか? これは、個人的な興味ですが・・・。

【68207】Re:InputBoxメソッドのD.Box位置について
発言  grok  - 11/2/14(月) 22:10 -

引用なし
パスワード
   こんばんは。
>
>>ところで、ご提示のTest1ですが、私の環境では、いまのところ何度実行しても
>>123 が入ります。
>>
>>なので、保証の限りではないということだろうと理解しています。
>そうなんですねえ・・・。
>
>因みにExcelバージョンやWinバージョンを教えてください。
>私のは、Win2000&Excel2002での結果です。
>
>Sub test1()
>  Dim g0 As Long
>  Range("a1").Select
>  SendKeys "abc{ENTER}"
>  For g0 = 1 To 1000
>   Range("a1").Value = Range("a1").Value + 1
>  Next
>End Sub
>
>これでも同じなんですか? これは、個人的な興味ですが・・・。

私は、Excel2003 & Vistaですが、
カウントアップされてから、abcが入りますね。

いやーこういうのを目にしてしまうと、ますますSendKeysを使う気が
なくなってきますね。(^^)

keybd_eventで、とおりすがりさんのコードを実現しようと粘ったのですが
ダメでした・・ これはSendKeysだからなせる技なんですね。

【68208】Re:InputBoxメソッドのD.Box位置について
発言  UO3  - 11/2/15(火) 0:46 -

引用なし
パスワード
   ▼ichinose さん:

お世話様です。

環境はXP+Excel2003です。
今回提供いただいたtest1も、この環境で実行しますと
A1は1000となりました。

【68210】Re:InputBoxメソッドのD.Box位置について
発言  ichinose  - 11/2/15(火) 6:11 -

引用なし
パスワード
   おはようございます。


UO3さん、grokさん、ご協力ありがとうございます。

>環境はXP+Excel2003です。
>今回提供いただいたtest1も、この環境で実行しますと
>A1は1000となりました。
なるほど・・・。

>いやーこういうのを目にしてしまうと、ますますSendKeysを使う気が
なくなってきますね。(^^)
そうですねえ!!

この結果だけだと、WinXPの動作に関係がある ということなのでしょうかねえ・・・。

一緒に記述すれば、よかったのですが、もう一つご協力お願いできますか?
Sendkeysには、ここまでに記述したSendkeysステートメントと

Application.Sendkeysメソッド
WshのSendkeysメソッド

が私が知っているものですが・・・・、

Sub test2()
  With Range("a1")
    .Value = ""
    .Select
    Application.SendKeys "abc{ENTER}"
    .Value = 123
  End With
End Sub
Sub test3()
  With Range("a1")
    .Value = ""
    .Select
    With CreateObject("WScript.Shell")
     AppActivate Application.Caption
     .SendKeys "abc{ENTER}"
    End With
    .Value = 123
  End With
End Sub

上記の二つでも結果は、同じですか?

Win2000&Excel2002では、どれも同じ結果で最後は、abcが表示されました。

【68211】Re:InputBoxメソッドのD.Box位置について
発言  UO3  - 11/2/15(火) 6:34 -

引用なし
パスワード
   ▼ichinose さん:

おはようございます。
出勤間にてとりいそぎ。

両方ともに abc 1でした。

ところが、test1 も、今朝は状況が異なります。
今度はエラーです。つまり先にabc が入力されたからでしょうね。
昨晩はそうじゃなかったんですが。
久しぶりにPCをシャットダウンリブートしましたので、その影響かも?

【68212】Re:InputBoxメソッドのD.Box位置について
発言  よろずや  - 11/2/15(火) 6:48 -

引用なし
パスワード
   Sendkeys には引数がもう一つありますけど...

【68213】Re:InputBoxメソッドのD.Box位置について
発言  UO3  - 11/2/15(火) 9:27 -

引用なし
パスワード
   ▼ichinose さん:

さきほどはちょっとあわただしいレスでした。
どうも、昨晩の結果と今朝の結果の相違が、ちょっと気持ちが悪いのですが
ichinoseさんが、後からアップされたtest1の結果を整理しますと
・昨晩 1000
・今朝 実行時エラー
今朝のケースはあきらかにSendKeysによる作用が最初に実行されセルにabcと入る。
で、そのあとセルの演算を行ったためエラー。
ではなぜ昨晩は?
推測ですが、昨晩は、SendKeysによる作用が、なんらかの理由で(メッセージキューのような
ものにSendKeysから送られた指令がたまるとして、そこをハンドリングする機能がビジー、
あるいは固まっていた?)実行されず演算が走り、演算終了後、しばらく待てば、もしかしたら
SendKeysによりabcとなったかもしれないのですが、その前にエクセルを終了させた?

で、同じXP+2003ですが、今、会社の環境で実行してみました。
2つアップされたtest1、2番目をtest1Xとしています。で、test1、test1Xともに
実行時エラーを回避するために、演算ループの前にRange("A1").ClearContentsをいれました。

さらに、よろずやさんのご指摘の第2引数にTrueをいれたものをそれぞれプロシジャ名の後ろ
にWをつけて実行。結果は以下の通りです。自宅環境とはまた異なった結果ですし、Waitが
有効に効いているケースと効いていないケースがあります。

どうもよくわからないというか、やはり気まぐれなんですかね?

test1,test1x,test2,test3 ともに abc
test1w 123
test1xw 1000
test2w abc
test3w abc

【68225】Re:InputBoxメソッドのD.Box位置について
発言  ichinose  - 11/2/15(火) 23:57 -

引用なし
パスワード
   こんばんは。


>どうもよくわからないというか、やはり気まぐれなんですかね?
>
>test1,test1x,test2,test3 ともに abc
>test1w 123
>test1xw 1000
>test2w abc
>test3w abc
この結果は、Win2000&Excel2002でも同じでした。

test1wやtest1xwの結果に対しては、
Sendkeysがリアルタイムに実行されるのですから、理屈はわかりますが、

test2wとtest3wは、意外ですね!! Trueの効果が出てないですね!!

 Application.SendKeys "abc{ENTER}"
 DoEvents
等としないと駄目ですね!!

このサイトで8年ぐらい前ですかねえ

vbalab.net/vbaqa/c-board.cgi?cmd=one;no=5831;id=excel

>間違っても売り物には使わないですね
↑これが戒めになっていて、仕事では使っていませんでした。
やっぱり、これは、間違いではなかったなあ


ご協力感謝します。ありがとうございました。

【68249】Re:InputBoxメソッドのD.Box位置について
お礼  あまがえる  - 11/2/17(木) 14:15 -

引用なし
パスワード
   UO3さま、grokさま、ichinoseさま

お礼がたいへん遅れて申し訳ありませんでした。

Sendkeysの実行がコードの記述順どおりになされるわけではないこと、しかもOSやExcelのバージョンによってその結果に違いが出ること、APIを使って目的の機能を実現できる方法があること、よくわかりました。
また、Sendkeysは私のところでもNumlockが解除されます。
これらは、大変勉強になりました。ありがとうございます。

ichinoseさまにご教示いただいたUserFormを使う方法でとりあえず目的のシステムを改良しようと考えています。RefEditコントロールのバグの問題どころかその存在すら知りませんでしたが、とても良い方法を教えていただいたと思います。
選択データが存在するシートでカーソルを動かさないときに備えて、デフォルト値としてRefEdit1.valueにアクティブセルのアドレスを下記のごとく書き込む形にしてみるつもりです。

Private Sub UserForm_Activate()
  
  RefEdit1.value = Selection.Address
  
  With Me
    .Left = 40000
    .Top = 40000
  End With
End Sub

********************************************************
また、もはや蛇足に近いとも思いますが、ichinoseさまの下記プロシージャについての私の2つの環境での結果をお伝えさせていただきます。

Sub test1()
  Range("a1").Select
  SendKeys "abc{ENTER}"
  Range("a1").value = 123
End Sub
→    XL2003 on XPHomeEditionSP3    :abc
    XL2010 on Win7HP        :abc

Sub test10()
  Dim g0 As Long
  Range("a1").Select
  SendKeys "abc{ENTER}"
  For g0 = 1 To 1000
   Range("a1").value = Range("a1").value + 1
  Next
End Sub
→    XL2003 on XPHomeEditionSP3    :カウントののちabc
    XL2010 on Win7HP        :カウントののちabc

Sub test2()
  With Range("a1")
    .value = ""
    .Select
    Application.SendKeys "abc{ENTER}"
    .value = 123
  End With
End Sub

→    XL2003 on XPHomeEditionSP3    :123
    XL2010 on Win7HP        :abc
※なぜか上記XL2003のみ「123」になります。ただし、何回か繰り返すと極くたまに、ですが「abc」になります。水もの・・・ですね(^^)

Sub test3()
  With Range("a1")
    .value = ""
    .Select
    With CreateObject("WScript.Shell")
     AppActivate Application.Caption
     .SendKeys "abc{ENTER}"
    End With
    .value = 123
  End With
End Sub
→    XL2003 on XPHomeEditionSP3    :abc
    XL2010 on Win7HP        :abc

2402 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free