[[20150803162650]]　『コードの省略化』（かつのん）　ページの最後に飛ぶ

『コードの省略化』（かつのん）

はじめまして。
初心者で申し訳ないですがVBAを勉強しよかなと思い投稿させてもらいました。

下図のように
WorkSheetにActiveXコントロールの
CommandButtonのまわりにImageを貼り付けてます。

  ___________________________________________________
 |                       Image1                      |
 |___________________________________________________|
 | Image2 | CommandButton1 | CommandButton2 | Image3 |
 |________|________________|________________|________|
 |                       Image4                      |
 |___________________________________________________|

やりたいことは
マウスポインタがCommandButtonの上に来た時に
CommandButtonのBackColorを変えることです。
UserForm上ではなくWorkSheet上のコントロールです。

Sheetモジュールに、これだけのプログラムを書きました。
これで一応思い通りに色が変わるのですが
こう言う場合に
IfとかSelect Caseをつかって省略できるのですか。

Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
CommandButton1.BackColor = &HFFEEE8
CommandButton2.BackColor = &H8000000F
End Sub

Private Sub CommandButton2_Click()
CommandButton2.BackColor = &HFFEEE8
CommandButton1.BackColor = &H8000000F
End Sub

Private Sub CommandButton2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
CommandButton2.BackColor = &HFFEEE8
CommandButton1.BackColor = &H8000000F
End Sub

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
CommandButton1.BackColor = &H8000000F
CommandButton2.BackColor = &H8000000F
End Sub

Private Sub Image2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
CommandButton1.BackColor = &H8000000F
CommandButton2.BackColor = &H8000000F
End Sub

Private Sub Image3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
CommandButton1.BackColor = &H8000000F
CommandButton2.BackColor = &H8000000F
End Sub

Private Sub Image4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
CommandButton1.BackColor = &H8000000F
CommandButton2.BackColor = &H8000000F
End Sub

＜使用 Excel：Excel2007、使用 OS：WindowsVista ＞

 もし、マウスがボタンを離れた認識を現在のように、周りをぎっしりと別のコントロールで覆い、
 そのコントロールでのMOUSEMOVEで把握しようとすれば、コードが簡略化になるかどうかははなはだ？ですが
 以下のような書き方もありますね。

 そうではなく、周りのコントロールの助けを借りず、CommandButto1,2 だけで処理しようとすれば
 それなりの監視ループのコードも考えられますが、そんなに大げさにしなくても、現在のコードないしは
 以下のコードで充分なのではと思います。

 Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    BtnSet 1
 End Sub

 Private Sub CommandButton2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    BtnSet 2
 End Sub

 Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    BtnSet 0
 End Sub

 Private Sub Image2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    BtnSet 0
 End Sub

 Private Sub Image3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    BtnSet 0
 End Sub

 Private Sub Image4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    BtnSet 0
 End Sub

 Private Sub BtnSet(n As Long)
    CommandButton1.BackColor = IIf(n = 1, &HFFEEE8, &H8000000F)
    CommandButton2.BackColor = IIf(n = 2, &HFFEEE8, &H8000000F)
 End Sub

（β） 2015/08/04(火) 13:33

 もし、周りを複数のイメージコントロールで取り囲んでいる目的がコマンドボタンを離れたかどうかの判定のみであれば
 大きな１つのイメージ(Image1)だけにして、その上にコマンドボタンを配置する方法もありますね。
 そうしておけば、イメージコントロールに対するプロシジャは１つだけでいいことになります。

 それとは別の監視ループ案です。コードが簡略になるわけでもないので、あまり有益ではないと思いますが。

 （.Net であれば MouseLeaveイベントをキャッチできるのですが、VBAではサポートされていないので）

 ThisWorkbookモジュール

 Option Explicit

 Const myName As String = "Sheet1"  '★対象シート名
 Dim DoLoop As Boolean
 Private Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long

 Private Type POINTAPI
    x As Long
    y As Long
 End Type

 Private Sub Workbook_Open()
    If ActiveSheet.Name = myName Then Application.OnTime Now(), "ThisWorkbook.BtnSet"
 End Sub

 Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name = myName Then Application.OnTime Now(), "ThisWorkbook.BtnSet"
 End Sub

 Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    If Sh.Name = myName Then DoLoop = False
 End Sub

 Public Sub BtnSet()
    Dim vv As Object
    Dim MPt As POINTAPI
    Dim color1 As Long
    Dim color2 As Long

    DoLoop = True

    Do While DoLoop
        GetCursorPos MPt
        Set vv = ActiveWindow.RangeFromPoint(MPt.x, MPt.y)

        color1 = &H8000000F
        color2 = color1

        If TypeName(vv) = "OLEObject" Then
            Select Case vv.Name
                Case "CommandButton1"
                    color1 = &HFFEEE8
                Case "CommandButton2"
                    color2 = &HFFEEE8
            End Select
        End If

        ActiveSheet.OLEObjects("CommandButton1").Object.BackColor = color1
        ActiveSheet.OLEObjects("CommandButton2").Object.BackColor = color2

        DoEvents
        DoEvents

    Loop

 End Sub

（β） 2015/08/04(火) 14:54

（β）様ご教授ありがとうございます。
2つの提案もいただきありがとうございます。

Private Sub CommandButton2_Click()
CommandButton2.BackColor = &HFFEEE8
CommandButton1.BackColor = &H8000000F
End Sub
は消去したつもりでした。ごめんなさい　^^;

そうです。マウスが当たっているコマンドボタンだけ色を変えて
マウスが外れれば元の色に戻す。で合ってます。

で、2つ目のコードを実行させてもらいました。
思い通りにコマンドボタンの色が変わりましたが
コマンドボタンよりはみ出た　Image のところで
イベント（クリック）が発生した時にコマンドボタンが消えて、マウスが
Image　の外に出るとコマンドボタンが現れる状態でした。

最初に大きめに作った　Image　にコマンドボタンを張り付けて
先ほどの初心者レベルのコードで実行した結果も同じ状態でした。
おそらくコントロールに何かイベントが発生すると前面に表示されるように
なってるかかなと思い　Image のプロパティも変更したりしてみましたが
思うような結果じゃなかったので
コマンドボタンの周りに　Image　を貼り付けました。

1つ目の　IIｆ関数を使ったコードが一番いい提案かなと思います。
（β）様の2つの提案を参考にまだまだ勉強いたします。

またほかにもいい提案があればご教授お願いします。

（かつのん） 2015/08/04(火) 17:01

 確かに　大きなイメージの上にコマンドボタンを配置し、イメージをクリックすると
 コマンドボタンが隠れますね。（クリックしなければ隠れないはずですが）
 で、この場合もマウスがイメージの外に出ればコマンドボタンが表示されるんですが、具合わるいですね。やっぱり。

 以下のような細工をすれば、どうでしょうか。

 Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    BtnSet 1
 End Sub

 Private Sub CommandButton2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    BtnSet 2
 End Sub

 Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    BtnSet 0
 End Sub

Private Sub Image1_Click()

    Shapes("Image1").Visible = False
    DoEvents
    Shapes("Image1").Visible = True
End Sub

 Private Sub BtnSet(n As Long)
    CommandButton1.BackColor = IIf(n = 1, &HFFEEE8, &H8000000F)
    CommandButton2.BackColor = IIf(n = 2, &HFFEEE8, &H8000000F)
 End Sub

 ところで、２つめのコードは　Imageコントロールを一切配置せず、CommandButton1,2 のみの配置を想定したものなんですが？
 まぁ、仮に大きなイメージコントロールを配置したとしても、↑の Image1_Clickの手当てを加えれば大丈夫だと思いますが。

（β） 2015/08/04(火) 17:40

 ↑でコメントした通り、アップした２つめのコードは、Imageコントロールの配置は想定していませんが
 仮に、何かしら必要性があって、大きな Image1 を配置するなら、Thisworkbookモジュールを以下に。

 Option Explicit

 Const myName As String = "Sheet1"  '★対象シート名
 Dim DoLoop As Boolean
 Private Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long

 Private Type POINTAPI
    x As Long
    y As Long
 End Type

 Dim WithEvents myImage As MSForms.Image

 Private Sub myImage_Click()
    Sheets(myName).Shapes("Image1").Visible = False
    DoEvents
    Sheets(myName).Shapes("Image1").Visible = True
 End Sub

 Private Sub Workbook_Open()
    Set myImage = Sheets(myName).Image1
    If ActiveSheet.Name = myName Then Application.OnTime Now(), "ThisWorkbook.BtnSet"
 End Sub

 Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name = myName Then Application.OnTime Now(), "ThisWorkbook.BtnSet"
 End Sub

 Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    If Sh.Name = myName Then DoLoop = False
 End Sub

 Public Sub BtnSet()
    Dim vv As Object
    Dim MPt As POINTAPI
    Dim color1 As Long
    Dim color2 As Long

    DoLoop = True

    Do While DoLoop
        GetCursorPos MPt
        Set vv = ActiveWindow.RangeFromPoint(MPt.x, MPt.y)

        color1 = &H8000000F
        color2 = color1

        If TypeName(vv) = "OLEObject" Then
            Select Case vv.Name
                Case "CommandButton1"
                    color1 = &HFFEEE8
                Case "CommandButton2"
                    color2 = &HFFEEE8
            End Select
        End If

        ActiveSheet.OLEObjects("CommandButton1").Object.BackColor = color1
        ActiveSheet.OLEObjects("CommandButton2").Object.BackColor = color2

        DoEvents
        DoEvents

    Loop

 End Sub

（β） 2015/08/04(火) 17:48

（β）様
昨日はいろいろな提案（コード）を用意していただきありがとうございました。
2つ目のコードを　Image　なしで実行させていただいたところ
まさに、思い通りに色が変わるようになりました。
UserForm上のコマンドボタンのように、WorkSheet上だと　ImageをUserForm代りに
しないといけないのかな？と思い今回のようなコードを書いていました。

前に違うコードですが色々調べてみたところ
”API"のことが書いてあり少しだけ読んだことがあります。
まだ　”API"のことを理解できていないですが、
今回のコードは

まず、POINTAPI　を使ってマウスの位置を取得して
コマンドボタンの処理を

 Select Case vv.Name　　　   ”マウスポインタの位置

    Case "CommandButton1"    "コマンドボタンの色を決める処理
          color1 = &HFFEEE8
    Case "CommandButton2"
          color2 = &HFFEEE8

でループするということかな　(^_^メ)

（β）さんの書いていただいたコードを参考にじっくり勉強させていただきます。

（かつのん） 2015/08/05(水) 13:13

 （β） 2015/08/04(火) 17:40 のほうがわかりやすければ、大きなImageを配置して、その上にComandButtonを置くというのも
 悪くはないと思いますよ。

 ２つ目のコードですが、使っているものは　GetCursorPos　です。POINTAPIは、GetCursorPosの結果の戻り値をいれる変数領域です。

 実際には　監視ループをぐるぐる走らせ、GetCursorPos　でカーソルの場所を取得し、その場所を
 ActiveWindow.RangeFromPoint というメソッドに与えて、その場所に何があるのかをチェックしています。

（β） 2015/08/05(水) 13:42

コメント返信：

[ 一覧(最新更新順) ]

[[20150803162650]] 『コードの省略化』（かつのん） ページの最後に飛ぶ

[[20150803162650]]　『コードの省略化』（かつのん）　ページの最後に飛ぶ