エクセル マクロ 表示ボックス？

質問

エクセル2002を使用しています。
「コントールツールボックス」の「スクロールバー」を動かしている際に
表示ボックス？で現在の数値を表示させることができるコマンドがあるのでしょうか？
よくファイルやメニューにマウスをのせると表示される添付のような表示ボックスです。

リスクしているセルは、別シートに配置しているため、数値を把握するには、
シートを変える必要があるので、できれば表示メッセージ系のマクロなどあったら助かります。

ご教授して頂けると助かります。

この投稿のマルチメディアは削除されているためご覧いただけません。

回答No.1

Wendy02 · ベストアンサー

>表示ボックス
たぶん、VBのToolTip のことだと思いますが、VBAでは、ControlTipText は似てはいます。

スクロールバーを、動かしている最中は、現れません。スクロールバーをからマウスを離し、再度、触ることで、数値が現れます。

Private Sub ScrollBar1_Change()
　ScrollBar1.ControlTipText = ScrollBar1.Value
End Sub

常時みるのでしたら、ラベルを上手に使ったほうが確実かもしれませんね。
「シートを変える必要があるので」ということと、ポップアップ表示とはどういう関係があるのか、あまり想像が付きません。実験的に試すなら、まだ他にあるようには思うのですが、試してみないと、分かりません。

お礼

返信ありがとうございます。ラベルも考えてみます。

回答No.3

Wendy02

#1 の回答者です。返事が遅くなりました。

ご希望のコードか分かりませんが、コードを作りましたので、コメント等に気をつけて貼り付けてください。改編する場合などは、気をつけて行ってください。ハングします。
あまり良く分からないようでしたら、そのままお使いになるか、新たに質問してください。

マウスカーソルに対して、表示するPopUpMenu を利用したものです。
'標準モジュール（上部から貼り付ける）
'Option Explicit

Public Const MF_STRING = &H0&
Public Const MF_SEPARATOR = &H800&
Public Const TPM_LEFTALIGN = &H0&
Public Const TPM_RETURNCMD = &H100&

Public Type POINTAPI
　x As Long
　y As Long
End Type

Public Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

Private Declare Function CreatePopupMenu& Lib "user32" ()
Private Declare Function AppendMenu& Lib "user32" Alias "AppendMenuA" (ByVal hMenu&, ByVal wFlags&, ByVal wIDNewItem&, ByVal lpNewItem As Any)
Private Declare Function TrackPopupMenu& Lib "user32" (ByVal hMenu&, ByVal wFlags&, ByVal x&, ByVal y&, ByVal nReserved&, ByVal hWnd&, lpReserved As Any)
Private Declare Function DestroyMenu& Lib "user32" (ByVal hMenu&)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long

Private MPtr As POINTAPI
Private pt3 As POINTAPI
Public CtrlValue As Long
Public Function PopUMn(h As Long) As Long
Dim hMenu As Long
On Error GoTo ErrHandler
hMenu = CreatePopupMenu()
AppendMenu hMenu, MF_STRING, 0&, CStr(CtrlValue) '"&New..."
GetCursorPos MPtr
PopUMn = TrackPopupMenu(hMenu, TPM_LEFTALIGN Or TPM_RETURNCMD, MPtr.x + 10, MPtr.y, 0, h, ByVal 0&)
ErrHandler:
DestroyMenu hMenu
End Function

'----
'シートモジュール
Private Sub ScrollBar1_Change()
　Dim hWnd As Long
　CtrlValue = ScrollBar1.Value
　hWnd = FindWindow("xlMain", 0&)
　PopUMn hWnd
　' PopUMn Application.hWnd 'Excel 2003 以上か
End Sub

回答No.2

imogasi

スクロールバーの直ぐ上に適当な大きさのテキストボックスを貼り付ける。
Private Sub ScrollBar1_Change()
Worksheets("Sheet1").TextBox1.Text = Worksheets("Sheet1").ScrollBar1.Value
End Sub
数字が変化して、出るようだが
ーーー
ミスタイプ？
コントールツールボックーー＞コンロトールツールボック
リスクしているーー＞リンクしている
でしょう。
添付のような表示ボックスーー＞画像が見えない
コントロールチップステキストのことか？
ーー
ユーザーフォーム上のスクロールバーのプロパティにはあるが、シート上に貼り付けるスクロールバーには無いようだ。

お礼

返信ありがとうございます。