[[20160309123155]]　『スクロールに追従して図形を表示する（ウィンドウ』（ぱぐ）　ページの最後に飛ぶ

『スクロールに追従して図形を表示する（ウィンドウ枠の固定ではありません。）』（ぱぐ）

図形をスクロールした時に追従させて表示させるようにしたくネットで検索したら下記のコードを見つてやりたいことはできたのですが、これに「特定の範囲を選択したとき」を追加したいのですが、どうすればよいかわからないので教えて頂きたく投稿致しました。

たとえばテキストボックス１をrange(B70:AU129)の範囲のセルを選択したときにオブジェクトが下記コードの位置に表示される、というのを作成したいと思っています。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With ActiveWindow.VisibleRange
Me.Shapes("テキストボックス 1").Left = .Left + .Width - Me.Shapes("テキストボックス 1").Width - 20
Me.Shapes("テキストボックス 1").Top = .Top + .Height - Me.Shapes("テキストボックス 1").Height - 20
End With
End Sub

上記のやり方かユーザーフォームを作成し、モードレスで表示をさせておく方法があると思うのですが、ユーザーフォームで行った場合で上から下にスクロールさせていったとき、例えばC列の見えているセルの文字を自動で更新して表示する。というようなことはできるのでしょうか？

ご教授ください。

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

 >>ユーザーフォームで行った場合で上から下にスクロールさせていったとき、例えばC列の見えているセルの文字を自動で更新して表示する。というようなことはできるのでしょうか？

 この意味がよくわかりません。
 質問は、指定位置に図形を配置するということではなかったのですか？
 文字を自動更新とは？？

 ということで、よくわかりませんが、以下は参考になりますか。
 （ＰＣによっては最下段、左端列が少しかけて表示されるかもしれませんが）

 Sub Test()
    Dim tl As Range, tr As Range, bl As Range, br As Range

    With ActiveWindow.VisibleRange
        Set tl = .Cells(1)
        Set tr = .Cells(1, .Columns.Count)
        Set bl = .Cells(.Rows.Count, 1)
        Set br = .Cells(.Rows.Count, .Columns.Count)

        MsgBox "表示されているセル領域は " & .Address & "です" & vbLf & _
            "左上隅: " & tl.Address & vbLf & _
            "右上隅: " & tr.Address & vbLf & _
            "左下隅: " & bl.Address & vbLf & _
            "右下隅: " & br.Address
    End With
 End Sub

（β） 2016/03/09(水) 13:03

分かりづらくすみません。
ユーザーフォームの件は、無しとさせてください。

下記のコードだと現状はどこのセルを選択しても「テキストボックス1」というのが
指定の箇所に出てきてしまいますが、このコードに特定の範囲のセルを選択した時だけ
「テキストボックス1」を表示させるように変更したいと思っています。

例えば
Range(A1:C10)までの範囲のセルを選択した時はテキストボックス1が指定位置に表示させる。
Range(A11:C20)までの範囲のセルを選択した時はテキストボックス2が指定位置に表示される。
Range(A21:C30)までの範囲のセルを選択した時はテキストボックス3が指定位置に表示される。

というのを作成したいと思っています。

（ぱぐ） 2016/03/09(水) 14:05

 【指定位置】というのがどこなのか、不明ですが、以下のコードは、該当の３つの領域の中心にテキストボックスの中心を配置します。
 もし、選択が該当領域ではなかったらテキストボックスは表示されません。

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim pos As Range

    Shapes("テキスト ボックス 1").Visible = False

    If Not Intersect(Target, Range("A1:C10")) Is Nothing Then
        Set pos = Range("A1:C10")
    ElseIf Not Intersect(Target, Range("A11:C20")) Is Nothing Then
        Set pos = Range("A11:C20")
    ElseIf Not Intersect(Target, Range("A21:C30")) Is Nothing Then
        Set pos = Range("A21:C30")
    End If

    If pos Is Nothing Then Exit Sub

    With Shapes("テキスト ボックス 1")
        .Left = pos.Left + pos.Width / 2 - .Width / 2
        .Top = pos.Top + pos.Height / 2 - .Height / 2
        .Visible = True
    End With

 End Sub

（β） 2016/03/09(水) 14:27

 ↑　あっと、領域ごとに表示するテキストボックスが異なるんですか！！

 後ほど、改訂版をアップします。

（β） 2016/03/09(水) 14:29

 案１　基本的にアップ済みコードとかわりません。領域ごとにテキストボックスをかえただけです。

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim pos As Range
    Dim sp As Shape

    Shapes("テキスト ボックス 1").Visible = False
    Shapes("テキスト ボックス 2").Visible = False
    Shapes("テキスト ボックス 3").Visible = False

    If Not Intersect(Target, Range("A1:C10")) Is Nothing Then
        Set pos = Range("A1:C10")
        Set sp = Shapes("テキスト ボックス 1")
    ElseIf Not Intersect(Target, Range("A11:C20")) Is Nothing Then
        Set pos = Range("A11:C20")
        Set sp = Shapes("テキスト ボックス 2")
    ElseIf Not Intersect(Target, Range("A21:C30")) Is Nothing Then
        Set pos = Range("A21:C30")
        Set sp = Shapes("テキスト ボックス 3")
    End If

    If pos Is Nothing Then Exit Sub

    With sp
        .Left = pos.Left + pos.Width / 2 - .Width / 2
        .Top = pos.Top + pos.Height / 2 - .Height / 2
        .Visible = True
    End With

 End Sub

 案２　お勧め版

 あらかじめ、３つのテキストボックスを表示したい場所にセットしておいてください。

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim sp As Shape

    Shapes("テキスト ボックス 1").Visible = False
    Shapes("テキスト ボックス 2").Visible = False
    Shapes("テキスト ボックス 3").Visible = False

    If Not Intersect(Target, Range("A1:C10")) Is Nothing Then
        Set sp = Shapes("テキスト ボックス 1")
    ElseIf Not Intersect(Target, Range("A11:C20")) Is Nothing Then
        Set sp = Shapes("テキスト ボックス 2")
    ElseIf Not Intersect(Target, Range("A21:C30")) Is Nothing Then
        Set sp = Shapes("テキスト ボックス 3")
    End If

    If sp Is Nothing Then Exit Sub

    sp.Visible = True

 End Sub

（β） 2016/03/09(水) 14:35

ありがとうございます。

やりたいことにかなり近づきました！

スクロールした時にその画面からいなくならず画面内の指定位置に表示させるということは
できますでしょうか？
（ぱぐ） 2016/03/09(水) 15:15

あっすみません。
指定位置というのは、例えば画面内の右下角に表示させる。というような感じです。
Excel内の領域のどこかではなくPC画面の常に右下に表示させるというようなイメージですが、
伝わりますでしょうか？
（ぱぐ） 2016/03/09(水) 15:45

 スクロールした状態のセルがどうなっているか、これは、参考コードとして　（β） 2016/03/09(水) 13:03　でアップしましたね。
 これを使えば、エクセル画面の右隅のセルが何なのか、把握できますね。
 そうすると、そのセル.Left+そのセル.Width-テキストボックスのWidth を　TextBoxのLeft にしてやることが考えられますね。
 Top についても同様に考えることができますね。

 もう１つ、PCのデスクトップ画面に対してセットする方法。
 ただしエクセルが最大化で表示されている状態が前提ですけど。

 Application.Left + Application.Width が　画面右端のポイント。
 Application.Top + Application.Height が画面の一番下のポイント。

 ここを起点にして、テキストボックス　の Left や Top を計算して設定することもできますね。

（β） 2016/03/09(水) 16:41

 ↑　２つの方法のうち、後のほうは、ちょっと思うような場所にするのに調整が面倒なので、最初のほうがいいですね。

 サンプルを。新規ブックのシートに　テキスト ボックス 1 を配置し、標準モジュールに以下を貼り付けて
 適当にスクロールして実行してみてください。

 Sub Sample()
    Dim br As Range

    With ActiveWindow.VisibleRange
        Set br = .Cells(.Rows.Count, .Columns.Count)
    End With

    With ActiveSheet.Shapes("テキスト ボックス 1")
        .Left = br.Left + br.Width - .Width
        .Top = br.Top + br.Height - .Height
        MsgBox .Left & vbLf & .Top
    End With

 End Sub

（β） 2016/03/09(水) 16:54

サンプルありがとうございます。

まさにサンプルのような感じです！
Excelをスクロールしても、表示倍率を変えても常に右下に来るので、まさにイメージ通りです。

ただこれと（β） 2016/03/09(水) 14:35で頂いたコードをうまく合わせることが
できるのでしょうか？

少しやってみたのですが、うまくいきませんでした。
（ぱぐ） 2016/03/09(水) 18:48

 以下で試してみてください。

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim sp As Shape
    Dim br As Range

    Shapes("テキスト ボックス 1").Visible = False
    Shapes("テキスト ボックス 2").Visible = False
    Shapes("テキスト ボックス 3").Visible = False

    If Not Intersect(Target, Range("A1:C10")) Is Nothing Then
        Set sp = Shapes("テキスト ボックス 1")
    ElseIf Not Intersect(Target, Range("A11:C20")) Is Nothing Then
        Set sp = Shapes("テキスト ボックス 2")
    ElseIf Not Intersect(Target, Range("A21:C30")) Is Nothing Then
        Set sp = Shapes("テキスト ボックス 3")
    End If

    If sp Is Nothing Then Exit Sub

    With ActiveWindow.VisibleRange
        Set br = .Cells(.Rows.Count, .Columns.Count)
    End With

    With sp
        .Left = br.Left + br.Width - .Width
        .Top = br.Top + br.Height - .Height
        .Visible = True
    End With

 End Sub

（β） 2016/03/09(水) 19:27

完璧です！
これがやりたかったのですごくスッキリしました！

本当にありがとうございました！
（ぱぐ） 2016/03/09(水) 20:02

コメント返信：

[ 一覧(最新更新順) ]

[[20160309123155]] 『スクロールに追従して図形を表示する（ウィンドウ』（ぱぐ） ページの最後に飛ぶ

[[20160309123155]]　『スクロールに追従して図形を表示する（ウィンドウ』（ぱぐ）　ページの最後に飛ぶ