Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(指定なし : 指定なし)
コメントのインジゲーターを非表示にしたい
投稿日時: 17/12/25 12:50:35
投稿者: millulillu

お世話になっております。
 
エクセルのコメントを設定しているセルには右上に赤い三角のインジゲーターが表示されますが、
これを非表示にしたいのですが、調べたところできないようでした。
 
代替え策でマウスカーソルの位置でセルを特定して、ラベル等のコントロールを表示非表示することでできそうだと思い調べているところですが、どのタイミングで表示を切り替えればよいでしょうか。
 
要望はセルをアクティブにしたくない、コメントのインジゲーターを表示したくないがコメント機能を利用したい。です。
 
何かヒントをいただけないでしょうか。
よろしくお願いします。
 

回答
投稿日時: 17/12/25 14:22:32
投稿者: Suzu

Excel 2010 の場合の操作
ファイルメニュー
 「ファイル」-「オプション」の中の 詳細設定 の 表示
 
   コメントのあるセルに対して表示: コメントとインジケーター両方なし
 
では希望と違いますか?

投稿日時: 17/12/25 16:19:41
投稿者: millulillu

Suzuさん、ありがとうございます。
 
確かにインジゲーターは消えますが、コメントも表示されなくなってしまいました。
 
コメントは従来通りに表示したいのです。

回答
投稿日時: 17/12/25 21:07:37
投稿者: simple

横入りします。
 
(1)
>要望はセルをアクティブにしたくない、
>コメントのインジゲーターを表示したくないがコメント機能を利用したい。です。

じゃあ、何をトリガーに、コメントを表示するんですか?
あなたがコメントを見たいと思った時? 以心伝心? まさか。
 
そういう「表示したいという意図」と「表示対象のコメントがどれか」を
何らかの形でPCに伝えなければならない、と思いませんか?
 
(2)
「コメントは利用可能でしかもインジケータを表示しない」という
状態にする方法はないと思います。
 
もちろん、三角形の図形(色は白)をそのセルの右上部分に重ねることで
見かけ上隠すことはできます。マクロで組めるでしょう。
しかし、トリッキーなことにどこまで手間をかけるのか、
というのが正直なところです。
どうしてもということなら、他人に頼らず、まずはご自分で努力すべきです。
 
(3)
提供された一般的な道具は、自然な形で利用したほうがよいと思います。
メモを作った直後は場所を覚えていても、不明になることはありますから、
インジケータは必要だろうと思います。
 
ただし、コメントを使わない時に、インジケータが邪魔だというなら

Application.DisplayCommentIndicator = xlNoIndicator
といったマクロを、クイックアクセスツールバーに登録しておけばよいでしょう。
 
コメントを使うときには、別のマクロを実行させればよいでしょう。
Application.DisplayCommentIndicator = xlCommentIndicatorOnly

投稿日時: 17/12/25 22:30:57
投稿者: millulillu

simpleさん、ありがとうございます。
 

simple さんの引用:

じゃあ、何をトリガーに、コメントを表示するんですか?
あなたがコメントを見たいと思った時? 以心伝心?

 
コメント同様にマウスがセル上にきた時に表示、離れたら非表示にしたいです。
 
シート上で、セルをアクティブにした際のマウスカーソルの位置は取得できたので、
マウスの移動で座標が取れればコメントに近いものが実装できると思い調べていたところです。
VBのMouseMoveイベントのようにシート上のマウスポインタの位置が取れればなんとかなるのですが。
 
それか、コメント自体を制御(オーバーライド)すればいいのかな。
できるのか調べてみます。
 
simple さんの引用:

提供された一般的な道具は、自然な形で利用したほうがよいと思います。
メモを作った直後は場所を覚えていても、不明になることはありますから、
インジケータは必要だろうと思います。

 
私もわざわざ消す必要ないと思うのですが、この場合のコメントは任意セルではなく決まった列にセルの内容の補足として使用するもので、入力時メッセージだとセルがアクティブになる必要があるためコメントを利用しようとなりました。マウス移動でサラサラと流し読みしたい、インジゲーターの赤い色がシート上に並ぶのが嫌という要望がありなんとか実現できないかと模索しています。

回答
投稿日時: 17/12/27 15:37:54
投稿者: でれすけ

こんにちは
 
入力規則の入力時メッセージを使うか
 
自分で表示を制御する
 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim aCell As Range
Dim c As Comment

   For Each c In Me.Comments
      c.Visible = False
   Next
   On Error Resume Next
   For Each aCell In Target
      aCell.Comment.Visible = True
   Next

End Sub

回答
投稿日時: 17/12/27 16:58:01
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:
私もわざわざ消す必要ないと思うのですが、この場合のコメントは任意セルではなく決まった列にセルの内容の補足として使用するもので、入力時メッセージだとセルがアクティブになる必要があるためコメントを利用しようとなりました。マウス移動でサラサラと流し読みしたい、インジゲーターの赤い色がシート上に並ぶのが嫌という要望がありなんとか実現できないかと模索しています。
 

 
話の内容からすると、特定の列・・・ということですが、
その列の全てのセルに「コメント」を設定するのではなく、項目行だけに「コメント」を設定しておく
という方法もありではないでしょうか?
(すべてのセルに同じ内容のコメントは、「しつこい」といわれそうです)
但し、当該列以外のセルの値でコメントの内容が変わる・・・なんてことがあれば別ですが・・・

投稿日時: 17/12/27 23:02:51
投稿者: millulillu

でれすけさん、コメントありがとうございます!
 

でれすけ さんの引用:

入力規則の入力時メッセージを使うか
自分で表示を制御する
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

 
ご提案いただいた2パターンはどちらもセルがアクティブにならないと動作しないのではないでしょうか?
 
コメントの表示条件はそのままに、インジゲーターを表示しない、もしくは、コメントに変わる何かが作れないか考えていますが、、、諦めモードです(´;ω;`)

投稿日時: 17/12/27 23:25:35
投稿者: millulillu

WinArrowさん、いつもありがとうございます!
 

WinArrow さんの引用:

当該列以外のセルの値でコメントの内容が変わる・・・なんてことがあれば別ですが・・・

 
御察しの通りでございます。
 
コメント内容は入れ替える必要があるのです。
セルの値が変わったら、その値を使用して計算した結果をコメントに表示します。
 
理由は列数の削減(計算結果は目視のみで問題ない)と、
計算式にユーザー定義関数を使用しており
シート保護で数式は見えないようにしていたのですが
解除されるといじれてしまうので
いっそのことない方が良いと思いコメントに至ったわけです。
 
なかなか時間が取れず試せてないですが
先日ご提案いただいた(削除されちゃったみたいですが)図形を重ねる方法をトライしてみます。

回答
投稿日時: 17/12/28 11:24:03
投稿者: 細雪

横から失礼します。
 
エクセル内で「ロールオーバーでポップアップ」に心当たりがありそうだったので
頭をひねって記憶を探ってみたのですが・・・
「ハイパーリンク」だったらほんの少し可能性がありそうだ、と思い立ちました。
 
    With Selection
        .Hyperlinks.Delete
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, _
                                   Address:="", _
                                   ScreenTip:="こめんと"
        With .Font
            .Underline = xlUnderlineStyleNone ' ハイパーリンクのアンダーラインを消去
            .ColorIndex = xlAutomatic     ' ハイパーリンクの文字色を自動(黒)
        End With
    End With
 
セル内の文字がある箇所にロールオーバーします。
  ※セル内の余白には反応しません。
んで、コメント機能と違って、ほんの一瞬タイムラグがあります。
難点はソコです。

回答
投稿日時: 17/12/28 11:37:05
投稿者: 細雪

書き忘れで連投失礼します。
 
ハイパーリンクを設定するに当たり、引数 ScreenTip について。
・文字列で指定する必要があります。数値を指定するとエラーで止まります。
・セルを参照しに行くのであれば、.Value を付けないとエラーで止まります。
以上2点ご注意ください。
計算結果を渡したいのであれば、Format や StrConv を使って文字列に変換してから渡せば通してくれます。
例えば・・・
   ScreenTip:=Cells(1, 1).Value
   ScreenTip:=StrConv(Cells(1, 1), vbNarrow)
   ScreenTip:=Format(1234, "#,##0")
こんな感じ。

回答
投稿日時: 17/12/28 14:22:18
投稿者: simple

私の投稿は放置されていたので、もう興味を失ったものとみなし削除しました。
見ていたなら何か短い返事でも返すくらい礼儀じゃないんですか?
質問しているのはあなたなんでしょ?ただの閲覧者じゃ困る。
 
 
さて、白色の三角形の図形を上書きするコード例を参考までに。
(こういう力業には眉をひそめる方も多かろうと思います。)
 
昔、インディケータの色を複数にして分類したい、という質問者さんがいて、
その時に書いたものを下敷きにしています。
(InputBoxで色を指定することで、対応してもらうものでした。)
 
今回の件では没であっても、
閲覧者さんのなかには、多色対応で分類に使うという用途はあるかもしれないと思い、
あえて投稿しておきます。
 
なお、私のお薦めは、
余計な加工はしないで、素のまま使ったほうがよいと関係者を説得すべし、
というものです。
 

Option Explicit

Type dot
    x As Double
    y As Double
End Type

Sub インディケータに白色三角形をかぶせる()
    pseudo_comment_indicator Columns("B")   '指定する範囲内のコメントに限定 ■要修正
   ' pseudo_comment_indicator                'すべてのコメントを対象
End Sub

Sub 白色三角形を削除()
    Dim shp As Shape

    For Each shp In ActiveSheet.Shapes
        If Not shp.TopLeftCell.Comment Is Nothing Then
            If shp.Type = msoFreeform Then
                shp.Delete
            End If
        End If
    Next
    '元々のindicator自体も,msoCommentをTypeとするshapeであることに注意。
End Sub

Function setdot(x As Double, y As Double) As dot
    setdot.x = x
    setdot.y = y
End Function

'3つの頂点(a,b,c)から三角形を描画。領域の色をmycolorに設定。
Sub triangle(a As dot, b As dot, c As dot, mycolor As Long)
    Dim myshape As Shape
    
    With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, a.x, a.y)
        .AddNodes msoSegmentLine, msoEditingAuto, b.x, b.y
        .AddNodes msoSegmentLine, msoEditingAuto, c.x, c.y
        .AddNodes msoSegmentLine, msoEditingAuto, a.x, a.y
        Set myshape = .ConvertToShape
    End With
    With myshape
        .Fill.Visible = msoTrue
        .Fill.Solid
        .Fill.ForeColor.SchemeColor = mycolor
        .Fill.Transparency = 0#
        .Line.Visible = msoFalse
    End With
End Sub

'インディケータに白色三角形を上書きする(対象範囲の限定も可能)
Function pseudo_comment_indicator(Optional myRange As Variant)
    Dim t As Double, l As Double, w As Double, h As Double
    Dim d As Double
    Dim r As Range
    Dim cm As Comment
    Dim flag As Boolean

    For Each cm In ActiveSheet.Comments
        flag = False        '白色三角形をかぶせるか(True)、否か(False)
        Set r = cm.Parent
        
        If IsMissing(myRange) Then
            flag = True
        Else
            If Not Intersect(myRange, r) Is Nothing Then
                flag = True
            Else
                flag = False
            End If
        End If

        If flag Then
            t = r.Top
            l = r.Left
            w = r.Width
            h = r.Height
            d = 5#      'ズームを変えた時は変更が必要かも
            Call triangle(setdot(l + w, t), setdot(l + w - d, t), _
                          setdot(l + w, t + d), CLng(1))
        End If
    Next
End Function

回答
投稿日時: 17/12/28 16:57:20
投稿者: Suzu

simple さんの引用:
さて、白色の三角形の図形を上書きするコード例を参考までに。
(こういう力業には眉をひそめる方も多かろうと思います。)

 
simpleさん まさしく チカラワザ ですね ^^;
 
個人的には shape が多くなるので避けたい。
 
要望の内容が明示されていないので何ともですが
 私なら、
   ・別カラムを作って対処
   ・ワークシートを入力画面としない → 別アプリ(Access)も考慮
 
何でもかんでも対処しようとして、リアルタイムで動作するマクロを作っても
データが多くなったりした時に動作速度の妨げになるのは目に見えていますよね。
 
現状、コメントを使用しているから ユーザーはそうしたい と言っているだけで
それに代わる案を 提示されてはいかがでしょう。

投稿日時: 17/12/28 23:28:48
投稿者: millulillu

simple さんの引用:
私の投稿は放置されていたので、もう興味を失ったものとみなし削除しました。
見ていたなら何か短い返事でも返すくらい礼儀じゃないんですか?
質問しているのはあなたなんでしょ?ただの閲覧者じゃ困る。

 
simpleさん、見捨てずにいてくださってありがとうございます。
 
自分で作成した結果を踏まえてお返事しようと思っておりましたが
ひとまずお礼をするべきでした。
お気を悪くさせてしまってごめんなさい。
 
そして、サンプルコードありがとうございます☆
拝見して絶対自分ではたどり着けない領域だと思いました。
 
msoEditingAutoとかdotとか
とにかく何が何だかわからないので調べてみます。
 
動作させてみてShapeでインジゲーターが隠れていることを確認しました。
これでコメントの色分けが可能ですね。すばらしいです。
 
インジゲーター自体を消しているわけではないので当たり前ですが、ソート時などセルが動く場合にちらっと元の赤色が見えることやコピー時にはShapeが付いてこない等、simpleさんがおっしゃっていたトリッキーなことにどこまで手間をかけるのかということにつながると思います。
 
simple さんの引用:
なお、私のお薦めは、
余計な加工はしないで、素のまま使ったほうがよいと関係者を説得すべし、
というものです。

 
そうですね。
インジゲーター消去に1週間かかるようなら困るといわれたので悔しいのですが
仕事納めの今日はコメントを実装しました。休み明けにリベンジしたいです。

投稿日時: 17/12/28 23:51:44
投稿者: millulillu

細雪さん、アドバイスありがとうございます。
 
今日は時間が取れたので早速、サンプル動作させてみました。
 
ポップアップが出ました!
ハイパーリンクがこのような使い方ができるとは知りませんでした。
 

細雪 さんの引用:
セル内の文字がある箇所にロールオーバーします。
  ※セル内の余白には反応しません。
んで、コメント機能と違って、ほんの一瞬タイムラグがあります。
難点はソコです。

 
タイムラグは私的には全然気になりません。
余白に反応せずとも、この限りでは問題なく使用できます。
 
うれしすぎて言葉になりません。
ほんとにありがとうございます。
 
ただ、分からないことがあって。
 
1回目の設定では問題ないのですが同じセルに続けて
2回目を実行するとセルの書式が初期化されてしまうようなのです。
 
ハイパーリンク設定前にセルの書式や罫線一式を変数に格納し、
設定後に書式を戻す方法で目的は達成できますが、、、
 
不思議な現象なので
もしお時間がありましたら
ご教示いただけますと幸いです。

回答
投稿日時: 17/12/29 00:11:00
投稿者: simple

質問者さんのみならず、閲覧されているかたのなにかの参考になれば幸いです。
 
ところで、コメントの数はどのくらいですか?
目で見るものだとすれば、
1万などというオーダーにはならないと思っているんですが
どうなんでしょう。
 
コピーしたあとで、@元に戻して、A再度、白色をかぶせるようにすれば、
所要時間の点からも許容範囲にはならないですか?

投稿日時: 17/12/29 14:40:41
投稿者: millulillu

Suzuさん、ありがとうございます。
 

Suzu さんの引用:

要望の内容が明示されていないので何ともですが
 私なら、
   ・別カラムを作って対処
   ・ワークシートを入力画面としない → 別アプリ(Access)も考慮
 
現状、コメントを使用しているから ユーザーはそうしたい と言っているだけで
それに代わる案を 提示されてはいかがでしょう。

 
コメントを利用する前はカラムに出力していたのですが
表示の問題で無駄なカラムは削除したいとの要望なのです。
 
カラムを増やさずに表示できるなら代案を提示できるのですが。
 
別アプリは難しいです。
今作っているものは既に運用されているファイルを使用しています。
また、サーバー上にあって各課の担当者が更新をかけていくという共有ファイルなので
勝手にフォーマットを変えたりできないのです。
 
最初から作れるのであればAccess、VBを検討するような内容のものなので
エクセルですべて行うのは厳しいと思っていますが、
そんなこと言える雰囲気ではないですね(^^;
 

投稿日時: 17/12/29 15:24:37
投稿者: millulillu

simpleさん、ありがとうございます。

simple さんの引用:
ところで、コメントの数はどのくらいですか?

max1000件を想定しています。
 
simple さんの引用:
コピーしたあとで、@元に戻して、A再度、白色をかぶせるようにすれば、
所要時間の点からも許容範囲にはならないですか?

列をコピーすることはあるかもしれないので試してみたのですが
1000件実行で4.06秒でした。
 
私の環境(EXCEL2016)ですと、上に配置しているシェイプからインジゲーターの赤色が
若干はみ出て見えますが(右上角の対角、内側の辺)コードの調整が必要でしょうか?
 
その影響からか罫線にもかぶさっています。
シートの表示倍率190%ですべて赤色が隠れますが、罫線にはかぶっています。
 
はたまた100%でインジゲーターを隠し、罫線にかぶらずに配置しても倍率変更でシェイプが微妙にずれてしまい赤色がはみだしてしまいます。シェイプがうまく動いていないのでしょうか。
ちなみにシェイプはセルに合わせて移動やサイズ変更をするになっています。

回答
投稿日時: 17/12/29 21:20:03
投稿者: simple

コメントありがとうございました。
(1)
Max は 1000個 程度ですか。
ですと、動かなくなることはないように思います。
 
・範囲を指定して、そのなかのコメントだけに三角形を追加
・白色三角形を追加、削除をする方法ではなく、
  VisibleプロパティをTrue,Falseにすると時間は節約できる
と思います。
 
(2)

引用:
私の環境(EXCEL2016)ですと、上に配置しているシェイプからインジゲーターの赤色が
若干はみ出て見えますが(右上角の対角、内側の辺)コードの調整が必要でしょうか?
そうですか。
環境が違うのでテストはできませんが、
コード中の d を少し大きくしてみるのでしょうか。
 
(3)
罫線にかかる点については、あそびを調整するのでしょうか。
 
例えばですが、
Const allowance_height As Double = 0.4 '縦方向の遊び
Const allowance_width As Double = 0.25 '横方向の遊び
などとモジュールレベルで定義しておいて、
    t = r.Top + allowance_height
    w = r.Width - allowance_width
などと調整してみてはいかがでしょうか。
私のところでは罫線にかかることはなくなりました。
 
なお、ズーム100%以外の場合は考えておりません。
どうか、そちらで必要に応じてご検討下さい。
(精細になるので、難易度は高くなるんでしょうね。)

投稿日時: 17/12/30 00:24:11
投稿者: millulillu

simpleさん、ご教示ありがとうございます(๑˃̵ᴗ˂̵)
 

simple さんの引用:
VisibleプロパティをTrue,Falseにすると時間は節約できる

試してみます!
 
引用:
私の環境(EXCEL2016)ですと、上に配置しているシェイプからインジゲーターの赤色が
若干はみ出て見えますが(右上角の対角、内側の辺)コードの調整が必要でしょうか?

 
simple さんの引用:
コード中の d を少し大きくしてみるのでしょうか。
罫線にかかる点については、あそびを調整するのでしょうか。

 
Const allowance_height As Double = 0.4 '縦方向の遊び
Const allowance_width As Double = 0.25 '横方向の遊び

 
環境と倍率に応じた数値をdと遊びの定数に持たせておいて、
表示倍率変更時に適用させればよいのですね
勉強になります。
 
環境による違いって大きいのですね。
会社は2010なので休み明けに確かめたいと思います。

回答
投稿日時: 17/12/31 18:25:21
投稿者: baoo

私も力業なんですが、少し考えていたことがあります。
非表示シートを用意してコメントのあるセルと非表示シートの同じアドレスのセルに
同じコメントを貼り付けて、そのセルに元のコメントのあったシート名を入力。
そして元のコメントを削除します。
コメントの無くなったシートのSelectionChangeイベントでTargetのアドレスと
同じ非表示シートのセルが""でなかったら、そこにはコメントがあるはずなので、
それをその現在のセルに貼り付けるという方法です。
複数シートに対応するために非表示シートに設定するコメントとシート名は
非表示シート以外のシート数のカンマ区切りで設定します。
 

'標準モジュール
Private Sub AllCommentToHide()
    
    Dim sht As Worksheet
    Dim cmt As Comment
    
    For Each sht In ThisWorkbook.Worksheets
        If sht.Name <> "HIDE" Then
            For Each cmt In sht.Comments
                AddCommentToHide cmt
            Next
        End If
    Next
    
End Sub
Private Sub AddCommentToHide(cmt As Comment)
    
    Dim strShtArry() As String
    Dim strCmtArry() As String
    Dim strSht As String
    Dim strCmt As String
    
    Dim i As Long
    
    With ThisWorkbook.Worksheets("HIDE").Range(cmt.Parent.Address)
        If .Value <> "" Then
            strShtArry = Split(.Value, ",")
            strCmtArry = Split(.Comment.Text, ",")
        Else
            ReDim strShtArry(ThisWorkbook.Worksheets.Count - 2) As String
            ReDim strCmtArry(ThisWorkbook.Worksheets.Count - 2) As String
        End If
        strShtArry(cmt.Parent.Parent.Index - 2) = cmt.Parent.Parent.Name
        strCmtArry(cmt.Parent.Parent.Index - 2) = cmt.Text
        For i = 0 To UBound(strShtArry)
            If i = 0 Then
                strSht = strShtArry(0)
                strCmt = strCmtArry(0)
            Else
                strSht = strSht & "," & strShtArry(i)
                strCmt = strCmt & "," & strCmtArry(i)
            End If
        Next i
        .Value = strSht
        .Comment.Delete
        .AddComment strCmt
    End With
    cmt.Delete
    
End Sub

'各シートモジュール
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim sht As Worksheet
    If Target.Cells.Count > 1 Then
        Exit Sub
    End If
    If Not tgtOld Is Nothing Then
        If Not tgtOld.Comment Is Nothing Then
            tgtOld.Comment.Delete
        End If
    End If
    If Worksheets("HIDE").Range(Target.Address).Value <> "" Then
        If Split(Worksheets("HIDE").Range(Target.Address).Value, ",")(Target.Parent.Index - 2) <> "" Then
            Target.AddComment Split(Worksheets("HIDE").Range(Target.Address).Comment.Text, ",")(Target.Parent.Index - 2)
            Target.Comment.Visible = True
            Set tgtOld = Target
        End If
    Else
        Set tgtOld = Nothing
    End If
End Sub

 
マウスオーバーでコメントを表示させることもできましたが、
カーソル位置取得タイミングの問題で不安定なのと、
無限ループで処理に負荷がかかりそうでよろしくないですね。

投稿日時: 18/01/01 11:40:02
投稿者: millulillu

baooさん、コメントありがとうございます!
 
ご提示いただいたコードを実行しようと思ったのですが
変数tgtOldが定義されていないとエラーが出てしまいました。
 
申し訳ございませんが、
ご教示いただけないでしょうか。
 
尚、私事ですが明日から3日間、通信不可地域におりますので
返信が1月5日以降となります。何卒よろしくお願いいたします☆

回答
投稿日時: 18/01/01 20:07:23
投稿者: baoo

あっ。
標準モジュールの1行目にPublic tgtold As Range
を挿入してください。
コピペミスです。
それと大事なことを忘れていました。
HIDEシートですが一番左に配置してindexが1となるようにしておいてください。

投稿日時: 18/01/07 15:34:48
投稿者: millulillu

baooさん、
返信が遅くなってしまい申し訳ありません。
   
ご教示ありがとうございました!
複数シートのコメント分けもカンマ区切りで再現できました。
 
コメントは常にセルに設定されている必要はないってことですね。
  
とても勉強になりました。
ありがとうございます。
   
ちなみに、マウスオーバーに非対応とのことですが、
不安定ながらも、そのようなプログラミングは可能だということですよね。
   
私が一番知りたかった内容なのでお尋ねしたいのですが
今回のようにマウスの動きを監視するような時、baooさんはどのようになさっていますか?
   
昔、VBをかじっていたのでtimerコントロールを使用した方法は覚えているのですが
それをEXCELのシート上で行いたい場合は…
   
ユーザーフォームにtimerコントロール(クラス)を実装し
シートが開くのと同時に動作させておけばマウスの監視が可能な気がしてきたのですが
(すみません、未検証です。VBブランク長いので勘違いだったらごめんなさい)
もしほかの方法があるのであればご教示いただけないでしょうか。
   
この流れで質問が良くないようでしたら新しく立ち上げます。
よろしくお願いいたします。

回答
投稿日時: 18/01/08 15:47:17
投稿者: WinArrow
投稿者のウェブサイトに移動

>マウスの動きを監視するような
 
コメントの三角マークを消すだけで、
ここまで、突っ込んだ対応は、行き過ぎのような気がいたします。
 
あとあとのことを考えると、シンプルな対応の方が、よいと思いますよ!
シンプル イズ ベスト・・・・ってこと言いますよね・・

回答
投稿日時: 18/01/08 20:46:30
投稿者: MMYS

Excelにはタイマー割り込みはサポートされていません。
そしてVBAはインタプリタ言語です。
つまり、とてつもなく遅い言語です。
 
仮に出来たとしても、VBAで常にマウス座標監視なんて、
不安定になると思いますけど。
 
マイクロソフトが想定(保証)した使い方で使うべきです。
業務は安定性が最優先でしょう。
 
 
 
ちなみに、お遊びや実験でやってみたいなら下記キーワードで検索して下さい。
・VBA タイマー割り込み
・VBA マウス座標

回答
投稿日時: 18/01/09 04:33:10
投稿者: baoo

まず最初に言っておきたいのは、私もsimpleさん、WinArrowさん、MMYSさんのおっしゃる通り
こういう無理筋なものはお勧めしないということです。
私が業務でこのようなプログラムを組むことも有りません。
ですので、当初回答しようか考えていて途中参戦ということになった次第です。
 
ExcelVBAにはタイマーコントロールは無かった筈です。
ではどうするかというのも結構悩ましいものがあります。
色んな方法があるかと思いますが、サブクラスやHook、SetTimerなどの高度なものは避けて
無限ループ+DoEventsで作成してみました。
でもこの方法も負荷がかかると思いますのであまりお勧めできません。
 
各ワークシートモジュールのイベントはコメントアウトしておいてください。
そして標準モジュールに下記を貼り付けて再起動し、
[アドイン]リボンの[CommentOn]ボタンをクリックして開始し、
再度クリックして終了します。

Option Explicit

Public Declare Function GetCursorPos Lib "user32" _
    (lpPoint As POINTAPI) As Long
Public Type POINTAPI
        x As Long
        y As Long
End Type
Public tgtOld As Range
Public blExecute As Boolean
'起動時にコメント表示用のボタンをアドインリボンに表示
Private Sub Auto_Open()
    
    Dim cb As CommandBar
    For Each cb In Application.CommandBars
        If cb.Name = "CommentCheck" Then
            cb.Delete
        End If
    Next
    
    Set cb = Application.CommandBars.Add("CommentCheck", msoBarTop, , True)
    With cb.Controls.Add(msoControlButton)
        .Caption = "CommentOn"
        .OnAction = "CommentOn"
        .Style = msoButtonCaption
    End With
    cb.Visible = True
    
End Sub
'終了時にコメント表示用ボタンをアドインから削除
Private Sub Auto_Close()

    Dim cb As CommandBar
    For Each cb In Application.CommandBars
        If cb.Name = "CommentCheck" Then
            cb.Delete
        End If
    Next

End Sub
'HIDEシート以外の全てのシートのコメントをHIDEシートに登録して削除
Private Sub AllCommentToHide()
    
    Dim sht As Worksheet
    Dim cmt As Comment
    
    For Each sht In ThisWorkbook.Worksheets
        If sht.Name <> "HIDE" Then
            For Each cmt In sht.Comments
                AddCommentToHide cmt
            Next
        End If
    Next
    
End Sub
'指定のコメントをHIDEシートに登録
Private Sub AddCommentToHide(cmt As Comment)
    
    Dim strShtArry() As String
    Dim strCmtArry() As String
    Dim strSht As String
    Dim strCmt As String
    
    Dim i As Long
    
    With ThisWorkbook.Worksheets("HIDE").Range(cmt.Parent.Address)
        If .Value <> "" Then
            strShtArry = Split(.Value, ",")
            strCmtArry = Split(.Comment.Text, ",")
        Else
            ReDim strShtArry(ThisWorkbook.Worksheets.Count - 2) As String
            ReDim strCmtArry(ThisWorkbook.Worksheets.Count - 2) As String
        End If
        strShtArry(cmt.Parent.Parent.Index - 2) = cmt.Parent.Parent.Name
        strCmtArry(cmt.Parent.Parent.Index - 2) = cmt.Text
        For i = 0 To UBound(strShtArry)
            If i = 0 Then
                strSht = strShtArry(0)
                strCmt = strCmtArry(0)
            Else
                strSht = strSht & "," & strShtArry(i)
                strCmt = strCmt & "," & strCmtArry(i)
            End If
        Next i
        .Value = strSht
        .Comment.Delete
        .AddComment strCmt
    End With
    cmt.Delete
    
    
End Sub
'コメントのマウスオーバーでの表示、非表示を切り替え
Private Sub CommentOn()
    
    With Application.CommandBars("CommentCheck").Controls(1)
        If .Caption = "CommentOn" Then
            .Caption = "CommentOff"
            blExecute = True
            Application.OnTime Now, "CommentCheckLoop"
        Else
            .Caption = "CommentOn"
            blExecute = False
        End If
    End With
    
    
End Sub
'無限ループでマウスカーソル下のセルがコメントのあるセルかチェックして表示
Private Sub CommentCheckLoop()
    
    Dim lngRet As Long
    Dim lngMax As Long
    Dim cl As Range     'マウスカーソル下のセル
    Dim oldCl As Range  '既にコメントを表示していた場合のセル
        
    Do
        DoEvents
        If ActiveSheet.Parent Is ThisWorkbook Then
            Set cl = GetClFromPoint(ActiveSheet)
            If Not cl Is Nothing Then
                '前回のコメントを削除
                If Not oldCl Is Nothing Then
                    If Not oldCl.Address = cl.Address Then
                        oldCl.Comment.Delete
                        Set oldCl = Nothing
                    End If
                End If
                'コメントのあるセルだったら表示
                If Worksheets("HIDE").Range(cl.Address).Value <> "" Then
                    If Split(Worksheets("HIDE").Range(cl.Address).Value, ",")(ActiveSheet.Index - 2) = ActiveSheet.Name Then
                        If oldCl Is Nothing Then
                            cl.AddComment Split(Worksheets("HIDE").Range(cl.Address).Comment.Text, ",")(ActiveSheet.Index - 2)
                            cl.Comment.Visible = True
                            Set oldCl = cl
                        End If
                    End If
                End If
            End If
            
            '終了フラグにより抜ける
            If blExecute = False Then
                Exit Do
            End If
        End If
    Loop
    
    '終了時にコメントが表示されてたら削除
    If Not oldCl Is Nothing Then
        oldCl.Comment.Delete
        Set oldCl = Nothing
    End If
    
    
End Sub
'指定のシート上のマウスカーソル下のセルを取得
Private Function GetClFromPoint(sht As Worksheet) As Range

    Dim lngRw As Long
    Dim lngCl As Long
    Dim lngX As Long
    Dim lngY As Long
    Dim pt As POINTAPI
    Dim lngRet As Long
    Dim cl As Range
    Dim A1LEFT As Long
    Dim A1TOP As Long
    
    Const DPI_PER_PPI = 0.75
    
    
    'カーソル位置をExcel座標に変換
    lngRet = GetCursorPos(pt)
    
    'スクリーン座標をシート上座標に変換
    With ThisWorkbook.Windows(1)
        A1LEFT = .PointsToScreenPixelsX(0)
        A1TOP = .PointsToScreenPixelsY(0)
        lngX = DPI_PER_PPI * (pt.x - A1LEFT) / (.Zoom / 100)
        lngY = DPI_PER_PPI * (pt.y - A1TOP) / (.Zoom / 100)
        lngRw = .ScrollRow      '表示されている一番上の行
        lngCl = .ScrollColumn   '表示されている一番左の列
    End With


    'マウス下の行を取得
    Do
        If sht.Rows(lngRw).Top < lngY And lngY < sht.Rows(lngRw + 1).Top Then
            Exit Do
        ElseIf sht.Rows(1).Top > lngY Then              'シート外
            Set GetClFromPoint = Nothing
            Exit Function
        ElseIf sht.Rows(lngRw).Top > lngY Then          '位置取得タイミングによってループが
            Set GetClFromPoint = Nothing                '取得行を超える場合がある
            Exit Function
        End If
        lngRw = lngRw + 1
    Loop
    
    'マウス下の列を取得
    Do
        If sht.Columns(lngCl).Left < lngX And lngX < sht.Columns(lngCl + 1).Left Then
            Exit Do
        ElseIf sht.Columns(1).Left > lngX Then          'シート外
            Set GetClFromPoint = Nothing
            Exit Function
        ElseIf sht.Columns(lngCl).Left > lngX Then      '位置取得タイミングによってループが
            Set GetClFromPoint = Nothing                '取得列を超える場合がある
            Exit Function
        End If
        lngCl = lngCl + 1
    Loop
    
    'カーソル下のセルを返す
    Set GetClFromPoint = sht.Cells(lngRw, lngCl)
    
End Function

投稿日時: 18/01/13 23:50:37
投稿者: millulillu

WinArrowさん、MMYSさん、
コメントありがとうございます。
 
エクセルで監視システムは可能ではあるが、
実現的には無理があるということですね。
 
VBの時は自由に組めていたものが、エクセルVBAとなると
エクセルの機能の理解、仕様やタスク負荷等、
考慮しなければならないことが沢山あってなかなか難しいです。
 
VBA初めて数ヵ月、まだまだ勉強不足ですが
壁にぶち当たれば当たるだけ上達もすると思うので
これからも頑張りたいと思います!!
 
この度は(も?)お付き合いありがとうございました。
また質問の際にはどうぞよろしくお願いいたします☆
 
 
 
 
 
 
 

投稿日時: 18/01/14 00:13:48
投稿者: millulillu

baooさん、お礼が遅くなり申し訳ありません;
 
サンプルコードありがとうございました!
 
プロシージャ内で無限ループさせ、DoEventsでマウス位置から
セルを取得しコメントを実装するという方法なのですね。
 
なるほどです。
確かにマウス監視が実現できました。
 
しかし、無限ループにいる間に別のプロシージャを実行してしまうと
ループから抜けてしまうため、マウス監視を行いつつほかのプロシージャを
実行することはできない(合ってますか?)
 
皆様にご忠告いただいたように
このようなプログラムは組むべきではないと
しみじみ感じました。
 
VBあがりですと、プログラムで何でもできるみたいな変な思い込みがあってダメですね。
もっとエクセル自体の勉強しないといけないなと思いました。
 
 

投稿日時: 18/01/14 00:55:38
投稿者: millulillu

皆様、この度はいろいろな方向から
ご教示くださりありがとうございました。
 
結果的には、細雪さんからご提案いただいた
ハイパーリンクのポップアップ表示を採用させていただきました。
 
今回はユーザー操作でポップアップ内容の入れ替えが発生するため、
ハイパーリンクをDeleteする必要がありました。
 
その後、ハイパーリンクのDeleteメソッドを使用するとセルの書式も削除されるのは
エクセルの仕様だと分かりましたので下記の流れで意図する動きに持っていきました。
 
Delete実行前に任意位置にセルをコピーしておきDelete実行後、
セルの書式のみを(セルの値は書き換わっているので)コピペすることで元の書式を復元し、
任意位置のセルを削除。
 
初めは書式を変数で保持していたのですが、ひとつひとつ設定するのは時間がかかるので
コピペが断然早かったです…
 
これで解決です。
本当にありがとうございました。
 
もう少し閉じずにおります。
追加コメントいただけたら嬉しいです。

トピックに返信