[[20150818194914]]　『コメントが出るようにしたいです。』（TOTAL）　ページの最後に飛ぶ

『コメントが出るようにしたいです。』（TOTAL）

いつもお世話になっております。

例えば

A1セルにこちらが指定した文字を入れます。
（指定した文字は数字の1とします）

1を入力した時にA1セルからコメントが吹き出しのように出るようにしたいのですが
そんなことってできますか？

入力した方にメッセージを伝えるのにインパクトがあるかな？と思って
出来るかどうかもまったくわからないのですが、こちらでお力を貸して頂けたら
助かります。

何卒よろしくお願い申し上げます。

＜使用 Excel：Excel2013、使用 OS：Windows7 ＞

イメージとかなり違うかもしれませんが、
とりあえず試してみてください。

 １）入力規則を使います。
 ２）ユーザー設定・数式：=A1<>1
 ３）エラーメッセージのスタイルを「情報」

（マナ） 2015/08/18(火) 20:20

 入力者にメッセージを伝えるということは重要なことですね。
 でも、その方策として、「コメント」を表示するということがベスト方法なのかどうかも
 検討してみる価値はありそうですね。

 たとえば

 ・A1を選択
 ・1 を入力してエンター
 ・標準設定ではカーソルはA2 にいきますね。

 このとき A1 の横あたりにコメント表示？
 ということは、ずっと（A1が 1 じゃなくなるまで）表示されっぱなしなんでしょうね。
 そうすると、コメントに覆われたセル領域 B列やC列に、何か入力したい時に邪魔になりませんか？

 カーソルが A1 にある間だけ表示ということだと、1 入力でエンターすると、A2にいってコメントが消えますから
 これまた、具合悪いですね。

 たとえば、A1が1 なら A1に色を付けるとか、そんな方法もありますよね。

（β） 2015/08/18(火) 20:47

 お遊び！
 ■シートモジュールに
    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim sp As Shape
        If Not Intersect(Target, Range("A1")) Is Nothing Then
            If Target.Value = 1 Then
                Set sp = Shapes.AddShape( _
                                    Type:=msoShapeBalloon, _
                                    Left:=Target.Left + Target.Width, _
                                    Top:=Target.Top, _
                                    Width:=100, _
                                    Height:=20 _
                                    )
                sp.Fill.ForeColor.RGB = RGB(100, 100, 200)
                sp.Line.ForeColor.RGB = RGB(50, 50, 150)
                With sp.TextFrame.Characters
                    .Text = Target.Value & "が入力されました"
                    .Font.Size = 10
                End With
                DoEvents
                sp_fade_out sp
            End If
        End If
    End Sub
    Private Function sp_fade_out(ByVal sp As Shape)
        Dim i As Double
        i = 0
        For i = 0 To 1 Step 0.02
            sp.Fill.Transparency = i
            sp.Line.Transparency = i
            Module1.Sleep 50
            DoEvents
        Next i
        sp.Delete
    End Function

 ■標準モジュールを挿入して（Module1とする）
 Option Explicit
 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

 これでA1に「1」と入力すると、吹き出しが出て、徐々に薄くなる、はず！
（稲葉） 2015/08/19(水) 09:41

 稲葉さんのコードほど派手さはないのですが、コメントを2秒程度表示した後、。自動的に消します。
 表示時間は★のところでミリ秒単位であたえていますので、増減はご自由に。

 ところで、稲葉さんのコード、Target.Value のところは　Range("A1").Value のほうが安全ですね。

 シートモジュール

 Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    If Range("A1").Value = 1 Then
        ShowComment
    Else
        DltComment
    End If
 End Sub

 標準モジュール

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

 Sub ShowComment()
    Range("A1").AddComment
    Range("A1").Comment.Visible = True
    Range("A1").Comment.Text "1が入力されましたよ～"
    SetTimer 0, 0, 2000, AddressOf ShowNext     '★セル編集中でもマクロを実行
 End Sub

 Function ShowNext(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal SysTime As Long) As Long
    KillTimer 0, idEvent
    DltComment
 End Function

 Sub DltComment()
    On Error Resume Next
    Range("A1").ClearComments
    On Error GoTo 0
 End Sub

（β） 2015/08/19(水) 17:05

 ↑　大見得をはって、編集中でも　なんて書きましたが、セル編集中に実行されるとコメント削除が
 できなくなります。セル編集中の場合は、素直に編集が終わった段階でコメントを削除します。
 （API使用をやめます）

 シートモジュールはかわりません。
 標準モジュールのみ以下に。

 Sub ShowComment()
    Range("A1").AddComment
    Range("A1").Comment.Visible = True
    Range("A1").Comment.Text "1が入力されましたよ～"
    Application.OnTime Now() + TimeSerial(0, 0, 2), "DltComment"
 End Sub

 Sub DltComment()
    On Error Resume Next
    Range("A1").ClearComments
    On Error GoTo 0
 End Sub

（β） 2015/08/19(水) 17:23

 あまり効果はないかも。1が入力されると、しばしフラッシュさせます。

 シートモジュールのみ。

 Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x As Long
    Dim flag As Boolean

    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    If Range("A1").Value <> 1 Then Exit Sub

    With Range("A1")
        For x = 1 To 20
            flag = Not flag
            If flag Then
                .Interior.ColorIndex = xlNone
                .Font.ColorIndex = xlAutomatic
            Else
                .Interior.Color = vbRed
                .Font.Color = vbWhite
            End If
            Sleep 50
         Next
        .Interior.ColorIndex = xlNone
        .Font.ColorIndex = xlAutomatic
    End With

 End Sub

（β） 2015/08/19(水) 21:34

 ついでに　（β） 2015/08/19(水) 17:23 でアップした構成が、あまりにもおバカだったので、再掲。

 標準モジュールは使いません。シートモジュールのみ。

 Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    If Range("A1").Value = 1 Then
        ShowComment
    Else
        DltComment
    End If

 End Sub

 Private Sub ShowComment()
    Range("A1").AddComment
    Range("A1").Comment.Visible = True
    Range("A1").Comment.Text "1が入力されましたよ～"
    Application.OnTime Now() + TimeSerial(0, 0, 2), Me.CodeName & ".DltComment"
 End Sub

 Private Sub DltComment()
    On Error Resume Next
    Range("A1").ClearComments
    On Error GoTo 0
 End Sub

（β） 2015/08/19(水) 21:42

皆様
色々とご提案して頂いてありがとうございます。
やりたい事が一発でできました。

本当にありがとうございます。
お礼が遅くなり誠に申し訳ございませんでした。
今後ともよろしくお願い致します。
（TOTAL） 2015/08/24(月) 13:10

コメント返信：

[ 一覧(最新更新順) ]

[[20150818194914]] 『コメントが出るようにしたいです。』（TOTAL） ページの最後に飛ぶ

[[20150818194914]]　『コメントが出るようにしたいです。』（TOTAL）　ページの最後に飛ぶ