excel スクロールしても常にボタンが表示される様にしたい。

excelで、スクロールしてもマクロを登録したボタンが表示されるようにしたいと考え、以下のマクロを作りました。


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim myBtn As Object, WinTop As Double, WinLeft As Double
On Error GoTo EndLine
Set myBtn = Sh.Shapes("ボタン 1")
If myBtn Is Nothing Then Exit Sub
WinTop = ActiveWindow.VisibleRange.Top
WinLeft = ActiveWindow.VisibleRange.Left
With myBtn
.Top = WinTop + 90 '上から
.Left = WinLeft + 790 '左から(右までで全部で650ぐらい）
End With

Set myBtn = Sh.Shapes("ボタン 2")
If myBtn Is Nothing Then Exit Sub
WinTop = ActiveWindow.VisibleRange.Top
WinLeft = ActiveWindow.VisibleRange.Left
With myBtn
.Top = WinTop + 210 '上から
.Left = WinLeft + 790 '左から(右までで全部で650ぐらい）
End With

EndLine:
End Sub

ボタン1とボタン2はそれぞれ別々のシートにあります。
このマクロですと、ボタン1は、上手く機能するのですが、ボタン2が機能しません。
どうすればよろしいでしょうか？？
初心者なので、出来るだけ詳しく回答願います。

No.3 ベストアンサー 回答者： nayuta_lot 回答日時： 2008/11/10 20:38

こんにちは

ボタンを固定したいだけなら、ANo1様の回答に私も賛同します。
ただ、ＶＢＡを勉強中ということで、どうしたもんか？ということで
あれば、一例として載せますのでご参考まで。

動かない理由はANo2様が指摘している通りだと思います。

ボタン２のあるシートの時でも、Set myBtn = Sh.Shapes("ボタン 1")
が実行されます。
On Error GoTo EndLineを指定しているので、エラーは表示されませんが、
実際にはエラーが発生して終了します。

試しにOn Error GoTo EndLineをコメントアウトして実行してみると
わかると思います。

---------------以下ＶＢＡ　参考------------------------------

Option Explicit　　　　　　　　　'おまじない

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

Dim myBtn　　As Object
Dim WinTop　 As Double
Dim WinLeft　As Double

On Error GoTo EndLine

If Sh.Name = "Sheet1" Then　　　　'Sh.Name は ActiveSheet.NameでもOK　Sheet1の名称は必要に応じて変更

　　'MsgBox ("Sheet1の時のみ実行します。")

　　Set myBtn = Sh.Shapes("ボタン 1")
　　WinTop = ActiveWindow.VisibleRange.Top
　　WinLeft = ActiveWindow.VisibleRange.Left

　　With myBtn
　　　　.Top = WinTop + 90　'上から
　　　　.Left = WinLeft + 790　'左から(右までで全部で650ぐらい）
　　End With

ElseIf Sh.Name = "Sheet2" Then　　'Sh.Name は ActiveSheet.NameでもOK　Sheet2の名称は必要に応じて変更
　　
　　'MsgBox ("Sheet2の時のみ実行します。")

　　Set myBtn = Sh.Shapes("ボタン 2")
　　WinTop = ActiveWindow.VisibleRange.Top
　　WinLeft = ActiveWindow.VisibleRange.Left

　　With myBtn
　　　　.Top = WinTop + 210　'上から
　　　　.Left = WinLeft + 790　'左から(右までで全部で650ぐらい）
　　End With

End If
EndLine:
End Sub

Option Explicit　は下記を参照
http://tryasp.winscom.co.jp/document/vbscript/58 …

If myBtn Is Nothing Then Exit Sub　での判定は　On Error GoTo EndLine
と同じ効果なので除外しています。

とりあえずご参考まで

この回答へのお礼

ありがとうございます。
思い通りの動作を得る事ができました。

お礼日時：2008/11/11 11:03

No.5 回答者： Wendy02 回答日時： 2008/11/11 00:37

こんばんは。

>初心者なので、出来るだけ詳しく回答願います。
そうは思えないのですが。誰かのコードを真似たのかな？

>ボタン1とボタン2はそれぞれ別々のシートにあります。

別々のシートにあるボタンを、一つのコードで処理しようとするのは、ありえないです。本来は、別々に作ったほうがよいです。こういうコードは、邪道かもしれません。


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
　　Dim myBtn As Object
　　Dim WinTop As Double
　　Dim WinLeft As Double

　　If Sh.Shapes.Count = 0 Then Exit Sub

　　On Error Resume Next

　　Set myBtn = Sh.Shapes("ボタン 1")
　　If Not myBtn Is Nothing Then
　　　　GoTo myExe
　　End If

　　Set myBtn = Sh.Shapes("ボタン 2")
　　If myBtn Is Nothing Then
　　　　Exit Sub
　　End If

myExe:
　　On Error GoTo 0
　　With myBtn
　　WinTop = ActiveWindow.VisibleRange.Top
　　WinLeft = ActiveWindow.VisibleRange.Left
　　　　.Top = WinTop + (ActiveWindow.VisibleRange.Height) / 4
　　　　.Left = WinLeft + (ActiveWindow.VisibleRange.Width) * 3 / 4
　　End With
　　Set myBtn = Nothing
End Sub


'WinLeft + 790　'左から(右までで全部で650ぐらい）
なぜ、650の範囲で、790と外に出してしまうのでしょうか。クリックできないと思います。

この回答への補足

こんにちは。

>そうは思えないのですが。誰かのコードを真似たのかな？

はい。教えてgooでコードを調べて少し改良したものです。


>なぜ、650の範囲で、790と外に出してしまうのでしょうか。クリックできないと思います。

'左から(右までで全部で650ぐらい）←この一文は、元にしたコードに最初から書いてあったものです。消去するのを忘れていました。混乱させてしまい、申し訳ございません。

大変参考になりました。ありがとうございます。

補足日時：2008/11/11 10:58

No.4 回答者： xls88 回答日時： 2008/11/10 22:13

ちょっと乱暴ですが

On Error Resume Next
と
On Error GoTo 0
を使ってみました。

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
　　Dim myBtn As Object, WinTop As Double, WinLeft As Double

　　On Error Resume Next　'(1)エラー行を無視し次の行から実行する
　　Set myBtn = Sh.Shapes("ボタン 1")
　　WinTop = ActiveWindow.VisibleRange.Top
　　WinLeft = ActiveWindow.VisibleRange.Left
　　With myBtn
　　　　.Top = WinTop + 90 '上から
　　　　.Left = WinLeft + 790 '左から(右までで全部で650ぐらい）
　　End With

　　Set myBtn = Sh.Shapes("ボタン 2")
　　WinTop = ActiveWindow.VisibleRange.Top
　　WinLeft = ActiveWindow.VisibleRange.Left
　　With myBtn
　　　　.Top = WinTop + 210 '上から
　　　　.Left = WinLeft + 790 '左から(右までで全部で650ぐらい）
　　End With
　　On Error GoTo 0　'(2)エラー処理を無効にする
End Sub

この回答への補足

大変参考になりました。
ありがとうございます。

補足日時：2008/11/11 11:01

No.2 回答者： fujillin 回答日時： 2008/11/10 18:20

＞ボタン1とボタン2はそれぞれ別々のシートにあります。

なので、ボタン2があるシート（このシートにボタン1はない）の時に・・・
＞Set myBtn = Sh.Shapes("ボタン 1")
＞If myBtn Is Nothing Then Exit Sub
で、ボタン1がないからそこで中断しているからでは？


なお、目的の解決方法としては、ANo1様の方法に賛成いたします。

この回答への補足

試してみたところ、仰るとおりでした。
ありがとうございます。

補足日時：2008/11/11 10:59

No.1 回答者： n_na_tto 回答日時： 2008/11/10 18:08

一般機能の「ウィンドウ枠の固定」では

だめなんでしょうか...

B3にボタンがあったら、
行方向、列方向ひとつ先に進んだC4セル選択
→ウィンドウ
→ウィンドウ枠の固定

この回答への補足

ウィンドウ枠の固定ですと、ボタンとエクセルで作った表の位置関係の都合で思うような結果が得られませんでした。
アドバイスありがとうございます。

補足日時：2008/11/11 10:46