エクセルの表に数字を入力するときに行と列に色をつける！！

Question

エクセルで大きな表を作成した時に、表に数字を入れる場合、行と列を間違えて入力してしまうことがあります。それを防止するためにあるマクロが動いているあいだは、マウスがオーバーする行、列のセルに色を付けるようなマクロを作ろうかと考えました。(セルなどをクリックしなくても、マウスが移動すれば、マウスがかかっているセルの行と列に色がついてまわる)単純に、MauseMoveイベントで処理って思いつきましたが、対象がグラフにしかありません。で、途方にくれました。また、仮に、イベントの処理方法が判ったとしても、単純にセルに色をつけたり消したりしたのでは、元々表に色が付いていた場合、消して回ることになります。なにか？どのようにすれば実現が可能でしょうか？イメージ的には、CADなどでX軸とY軸に垂線と水平線がカーソルについて回るって感じです。
最大の問題は、カーソルが通り過ぎた時に元々の色に戻すっててんだと思いますが、どなたか？詳しい方がイラッシャイましたら教えて頂けないでしょうか？
宜しくお願い致します。

KenKen_SP · Accepted Answer

こんにちは。KenKen_SP です。

＞ #案外実用的かも^ ^

すみません。やっぱり、#3 はうまくいかないみたいです。Excel で CallBack
プロシージャを使うとコードに一見問題がないように見えても、何故か数秒後
にフリーズしたりして非常に苦労するのですが、今回は結構動いてたので、
調子にのって投稿してしまいました。しかし、しばらくほっとくと、フリーズ
こそしないのですが、CallBack されなくなって動かなくなります。これでは
使い物にならないですね...

いろいろ調整してみましたが、（私のスキルでは）実用不可でした。

少し真面目に実用に耐え得るコードを書いてみました。こっちの方がご質問の
ご希望に近いかもしれません。

#3 と同じように、ユーザーフォームにトグルを一つ貼り付けて、コードをコピペ
して下さい。今度はフォームモジュールのみで完結させてます。

このフォームを vbModeless で呼び出すか、VBE のフォームの ShowModal プロパ
ティーの値を False にしておきます。

'　ソースコード（フォームモジュール）------------------------------------

Option Explicit

Private mLineHT As Shape, mLineHB As Shape
Private mLineVL As Shape, mLineVR As Shape

Private Const BASENAME　　As String = "$CurLine_$"
Private Const MARJIN　　　As Single = 500
Private Const LINE_WEIGHT As Single = 1.5　’線の太さをPtで設定

Private WithEvents xlApp As Application
Private mSh As Worksheet

Private Sub UserForm_Initialize()
　　
　　' 初期化
　　With Me
　　　　.StartUpPosition = 0 ' Manual
　　　　.Width = 80: .Height = 40
　　　　.Caption = "Line Cursol"
　　　　' 初期表示位置（適当に修正して下さい）
　　　　.Top = ActiveWindow.Top + 120
　　　　.Left = ActiveWindow.Width - .Width - 40
　　End With
　　With Me.ToggleButton1
　　　　.Top = 0: .Left = 0
　　　　.Width = Me.InsideWidth: .Height = Me.InsideHeight
　　　　.Caption = "On"
　　End With
　　Set xlApp = Application
　　Set mSh = ActiveSheet
　　Exit Sub

ERROR_HANDLER:
　　MsgBox Err.Description, vbExclamation
　　Unload Me

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
　　Call Lines_Del(True)
　　Set mSh = Nothing
　　Set xlApp = Nothing
End Sub

Private Sub ToggleButton1_Change()
　　
　　Dim i As Long
　　With Me.ToggleButton1
　　　　If .Value Then
　　　　　　.Caption = "On"
　　　　　　Call Lines_Add
　　　　Else
　　　　　　.Caption = "Off"
　　　　　　Call Lines_Del
　　　　End If
　　End With

End Sub

Private Sub Lines_Add()

　　On Error Resume Next
　　Application.ScreenUpdating = False
　　If Not mSh Is ActiveSheet Then
　　　　Call Lines_Del
　　　　Set mSh = ActiveSheet
　　End If
　　Call Lines_Del
　　With ActiveCell.MergeArea
　　　　Set mLineHT = sp_DrawLine(.Top)
　　　　Set mLineVL = sp_DrawLine(, .Left)
　　　　Set mLineHB = sp_DrawLine(.Top + .Height)
　　　　Set mLineVR = sp_DrawLine(, .Left + .Width)
　　End With

End Sub

Private Sub Lines_Del(Optional ByVal ALL_LINES As Boolean)

　　Dim Wb　　　As Workbook
　　Dim Sh　　　As Worksheet
　　Dim shpLine As Shape
　　
　　If Not ALL_LINES Then
　　　　On Error GoTo ALL_LINES_DELETE
　　　　mLineHT.Delete: mLineHB.Delete
　　　　mLineVL.Delete: mLineVR.Delete
　　Else
ALL_LINES_DELETE:
　　　　On Error Resume Next
　　　　For Each Wb In Workbooks
　　　　　　For Each Sh In Wb.Worksheets
　　　　　　　　For Each shpLine In Sh.Shapes
　　　　　　　　　　If shpLine.Name Like BASENAME & "*" Then
　　　　　　　　　　　　shpLine.Delete
　　　　　　　　　　End If
　　　　　　　　Next shpLine
　　　　　　Next Sh
　　　　Next Wb
　　End If
　　
　　Set mLineHT = Nothing: Set mLineHB = Nothing
　　Set mLineVL = Nothing: Set mLineVR = Nothing
　　On Error GoTo 0

End Sub

Private Function sp_DrawLine( _
　　Optional ByVal sglT As Single, _
　　Optional ByVal sglL As Single) As Shape
　　　　
　　Dim sglW As Single
　　Dim sglH As Single
　　
　　sglW = Columns(Columns.Count).Left + MARJIN
　　sglH = Rows(Rows.Count).Top + MARJIN
　　If sglL = 0 And sglT >= 0 Then
　　　　Set sp_DrawLine = ActiveSheet.Shapes.AddLine(0#, sglT, sglW, sglT)
　　ElseIf sglT = 0 And sglL >= 0 Then
　　　　Set sp_DrawLine = ActiveSheet.Shapes.AddLine(sglL, 0#, sglL, sglH)
　　Else
　　　 Err.Raise 1000, , "sp_DrawLine 関数に不正パラメータが渡されました."
　　End If
　　With sp_DrawLine
　　　　.Name = BASENAME & .Name
　　　　.Line.Weight = LINE_WEIGHT
　　　　.Line.Style = msoLineSingle
　　　　.Line.ForeColor.SchemeColor = 48
　　End With
　
End Function

Private Sub xlApp_SheetActivate(ByVal Sh As Object)
　　If Me.ToggleButton1.Value Then
　　　　Call Lines_Add
　　End If
End Sub

Private Sub xlApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
　　If Me.ToggleButton1.Value Then
　　　　Call Lines_Add
　　End If
End Sub

Private Sub xlApp_WorkbookBeforePrint(ByVal Wb As Workbook, Cancel As Boolean)
　　Call Lines_Del
End Sub

Private Sub xlApp_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
　　Call Lines_Del
End Sub

pauNed · Answer

こんにちは。
KenKen_SPさん、スゴいですね。勉強になります。ありがとうございました。m(_ _)m
私の環境でも使用できました。（win2000/xl2000）
他のwinXP/xl2003にもDirectX8は入ってましたので、
使える環境は多いのではないでしょうか。
#案外実用的かも^ ^

>vba_minaraiさんへ
蛇足ながら、Zoom補正ですが

Option Explicit

Private sx As Single
Private sy As Single

Sub 補正()
　　Dim rng As Range
　　With ActiveSheet
　　　　On Error Resume Next
　　　　.Ovals("oval_S").Delete
　　　　On Error GoTo 0
　　　　Set rng = .Range("IV65536")
　　　　Application.Goto rng
　　　　With .Shapes.AddShape(msoShapeOval, rng.Left - 4, rng.Top - 4, 8, 8)
　　　　　　.Name = "oval_S"
　　　　　　.Fill.ForeColor.SchemeColor = 10
　　　　　　.OnAction = "center_click"
　　　　End With
　　End With
　　Set rng = Nothing
　　MsgBox "最終セルの赤丸 Click"
End Sub

Sub center_click()
　　Dim xi As Single, yi As Single, n As Long
　　On Error Resume Next
　　Call GetCursorPos(MoP)
　　With ActiveWindow
　　　　n = .Zoom
　　　　xi = (MoP.X - .PointsToScreenPixelsX(Range("A1").Left)) * 300 / (4 * n)
　　　　yi = (MoP.Y - .PointsToScreenPixelsY(Range("A1").Top)) * 300 / (4 * n)
　　End With
　　With ActiveSheet.Ovals("oval_S")
　　　　sx = .Left / xi
　　　　sy = .Top / yi
　　　　.Delete
　　End With
　　MsgBox "ok: " & sx & " / " & sy
　　Application.Goto Range("A1")
End Sub

...と係数になるようなものを取得しておいて

With ActiveWindow
　n = .Zoom
　Ln = (MoP.X - .PointsToScreenPixelsX(Range("A1").Left)) * 300 / (4 * n) * sx
　Tn = (MoP.Y - .PointsToScreenPixelsY(Range("A1").Top)) * 300 / (4 * n) * sy
End With

...とすればいいかもしれません。
もしかしたら自動で取得できるのかもしれませんが、わかりませんでした^ ^;
（どこかでsxとsyの初期値を1にする処理が必要）
（* 300 / (4 * n) は元の * 3 / 4 にZoomの%を掛け合わせただけです）

また、セル選択を考慮するなら
.Left = Ln + 3
.Top = Tn + 4
などと少し調整したほうがいいかもしれませんね。

KenKen_SP · Answer

こんにちは。KenKen_SP です。

本来は、外部のツールを使った方が良いのかもしれません。

アイディアと一部コードは #1 の pauNed さんのものをお借りしましたm(_ _)m

Do ～ Loop でマウスの位置を監視する方法だとキー入力がうまくできなかった
ので、DirectInput を使ってみました。CPU 負荷はマウスを動かしているとき
だけかかります。ただし、それなりにマシンスペックは必要です。

テスト環境は WindowsXP + DirectX8 + Excel2002 です。

また、私の PC には Visual Basic 6.0 がインストールされているのですが、
他環境ではテストしてません。きっと、VB がインストールされないとダメな気
がしますね...環境を著しく限定させてしまい実用的ではないです。

エラートラップはしてありますが、挙動不信なときもあるので、テストコード
扱いです。いきなり Excel がフリーズするかもしれません。十分ご注意下さい。

このような状況に加え、コメントはほぼ入れてませんし、コードの解説もできま
せんので、この場で公開できるものなのか悩みましたが、面白そうなので参加し
ちゃいます。


【手順】
　　0.　VBE で DirextX x Visual Basic Type Library を参照設定
　　1.　フォーム（Userform1）、標準モジュールをそれぞれ挿入
　　2.　フォームに ToggleButton1 を配置
　　3.　以下のコードをそれぞれの場所にコピペ
　　4.　Userform1 を下記のコードで開く

　　　　Userform1.Show vbModeless

それにしても....長すぎですね、すみませんm(_ _)m

【以下ソースコード】

'----------------- Userform1 フォームモジュール -----------------

Option Explicit

' 要参照設定 DirextX x Visual Basic Type Library

Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
　　 ByVal lpClassName As String, _
　　 ByVal lpWindowName As String _
) As Long
Private Declare Function GetCursorPos Lib "user32.dll" ( _
　　lpPoint As POINTAPI _
) As Long
Private Declare Function SetActiveWindow Lib "user32.dll" ( _
　　 ByVal hwnd As Long _
) As Long

Private Type POINTAPI
　　X As Long
　　Y As Long
End Type

Private MoP　 As POINTAPI
Private mhWnd As Long
Private mSh　 As Worksheet
Private mLine_H As Shape
Private mLine_V As Shape

' DirectInput
Implements DirectXEvent8

Private mDX　　　As DirectX8
Private mDI　　　As DxVBLibA.DirectInput8
Private mDIDevM　As DxVBLibA.DirectInputDevice8
Private mhEventM As Long

Private Const MAX_BUFFERSIZE As Long = 10
'

Private Sub UserForm_Initialize()
　　
　　' フォーム・コントロールの初期化
　　With Me
　　　　.Width = 80: .Height = 40
　　End With
　　With Me.ToggleButton1
　　　　.Top = 0: .Left = 0
　　　　.Width = Me.InsideWidth: .Height = Me.InsideHeight
　　　　.Caption = "Cross Cursol Off"
　　End With
　　On Error GoTo ERROR_HANDLER
　　
　　' Userform のウインドウハンドル
　　mhWnd = FindWindow("ThunderDFrame", Me.Caption)
　　If mhWnd > 0 Then
　　　　Call InitDirextInput
　　Else
　　　　Err.Raise 1000, , "Userform の hWnd が取得できませんでした"
　　　　Unload Me
　　End If
　　
　　Set mSh = ActiveSheet
　　
　　Exit Sub

ERROR_HANDLER:
　　Set mDIDevM = Nothing
　　Set mDI = Nothing
　　Set mDX = Nothing
　　Set mSh = Nothing
　　MsgBox Err.Description, vbExclamation

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
　　
　　' ライン消去
　　Call Lines_Del
　　' アクセス権を破棄してオブジェクトの参照を開放
　　If Not mDIDevM Is Nothing Then
　　　　mDIDevM.Unacquire
　　End If
　　Set mDIDevM = Nothing
　　Set mDI = Nothing
　　Set mDX = Nothing
　　Set mSh = Nothing

End Sub

Private Sub ToggleButton1_Change()
　　
　　Dim i As Long
　　With Me.ToggleButton1
　　　　If .Value Then
　　　　　　With Application
　　　　　　　　.Cursor = xlNorthwestArrow
　　　　　　　　.StatusBar = "" 'チラつくので消しておく
　　　　　　End With
　　　　　　.Caption = "Cross Cursol On"
　　　　　　' ライン描写
　　　　　　Call Lines_Add
　　　　　　Call LineMove
　　　　　　' アクセス権取得
　　　　　　If Not mDIDevM Is Nothing Then
　　　　　　　　mDIDevM.Acquire
　　　　　　End If
　　　　Else
　　　　　　Call Lines_Del
　　　　　　With Application
　　　　　　　　.Cursor = xlDefault
　　　　　　　　.StatusBar = False
　　　　　　End With
　　　　　　' アクセス権破棄
　　　　　　.Caption = "Cross Cursol Off"
　　　　　　On Error Resume Next
　　　　　　mDIDevM.Unacquire
　　　　　　' 待機（簡易ウェイト...なんかうまく開放されない時があるので2回試す）
　　　　　　For i = 1 To 500000: DoEvents: Next i
　　　　　　mDIDevM.Unacquire
　　　　　　On Error GoTo 0
　　　　　　Call SetActiveWindow(FindWindow("XLMAIN", vbNullString))
　　　　End If
　　End With

End Sub

Private Sub InitDirextInput()

　　Set mDX = New DxVBLibA.DirectX8
　　Set mDI = mDX.DirectInputCreate()
　　If mDI Is Nothing Then
　　　　Err.Raise 1000, , "DirectInput オブジェクト生成に失敗しました."
　　End If

　　Set mDIDevM = mDI.CreateDevice("guid_SysMouse")
　　If mDIDevM Is Nothing Then
　　　　Err.Raise 1000, , "DirectInputDevice オブジェクト生成に失敗しました."
　　Else
　　　　mDIDevM.SetCommonDataFormat DIFORMAT_MOUSE2
　　　　mDIDevM.SetCooperativeLevel mhWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
　　　　Dim diprop As DxVBLibA.DIPROPLONG
　　　　With diprop
　　　　　　.lHow = DIPH_DEVICE
　　　　　　.lObj = 0
　　　　　　.lData = 10
　　　　End With
　　　　mDIDevM.SetProperty "DIPROP_BUFFERSIZE", diprop
　　　　mhEventM = mDX.CreateEvent(Me)
　　　　mDIDevM.SetEventNotification mhEventM
　　End If

End Sub

' DirectX イベント
Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long)

　　Dim X　　As Long
　　Dim lngX As Long
　　Dim lngY As Long
　　
　　Select Case eventid
　　　　Case mhEventM ' マウスイベント
　　　　　　Dim devdata(MAX_BUFFERSIZE - 1) As DxVBLibA.DIDEVICEOBJECTDATA
　　　　　　Dim datacnt As Long
　　　　　　On Error Resume Next
　　　　　　datacnt = mDIDevM.GetDeviceData(devdata, DIGDD_DEFAULT)
　　　　　　If Err Then
　　　　　　　　datacnt = 0
　　　　　　　　mDIDevM.Acquire
　　　　　　End If
　　　　　　On Error GoTo 0
　　　　　　For X = 0 To datacnt - 1
　　　　　　　　With devdata(X)
　　　　　　　　　　Select Case .lOfs
　　　　　　　　　　　　Case DIMOFS_X, DIMOFS_Y　' X軸、Y軸の移動
　　　　　　　　　　　　　　Call LineMove
　　　　　　　　　　　　Case Else
　　　　　　　　　　End Select
　　　　　　　　End With
　　　　　　Next
　　　　Case Else
　　End Select

End Sub

Private Sub LineMove()
　　
　　Dim sglL As Single
　　Dim sglT As Single
　　
　　If Not mSh Is ActiveSheet And Me.ToggleButton1.Value Then
　　　　Call Lines_Add
　　　　Set mSh = ActiveSheet
　　Else
　　　　On Error Resume Next
　　　　Call GetCursorPos(MoP)
　　　　sglL = (MoP.X - ActiveWindow.PointsToScreenPixelsX _
　　　　　　　　(Range("A1").Top)) * 3 / 4
　　　　sglT = (MoP.Y - ActiveWindow.PointsToScreenPixelsY _
　　　　　　　　(Range("A1").Left)) * 3 / 4
　　　　mLine_V.Left = sglL
　　　　mLine_H.Top = sglT
　　End If

End Sub

Private Sub Lines_Add()

　　Dim sglW As Single, sglH As Single
　　
　　On Error GoTo ERROR_HANDLER
　　Call Lines_Del
　　sglW = Range("IV1").Left + 500
　　sglH = Range("A65536").Top + 500
　　Set mLine_H = Nothing
　　Set mLine_V = Nothing
　　Set mLine_H = ActiveSheet.Shapes.AddLine(0#, 10#, sglW, 10#)
　　With mLine_H
　　　　.Name = "$CurLine_H$" & .Name
　　　　.Line.Weight = 1
　　　　.Line.Style = msoLineSingle
　　　　.Line.ForeColor.SchemeColor = 48
　　End With
　　Set mLine_V = ActiveSheet.Shapes.AddLine(10#, 0#, 10#, sglH)
　　With mLine_V
　　　　.Name = "$CurLine_V$" & .Name
　　　　.Line.Weight = 1
　　　　.Line.Style = msoLineSingle
　　　　.Line.ForeColor.SchemeColor = 48
　　End With
　　Exit Sub
　　
ERROR_HANDLER:
　　MsgBox "ライン描写に失敗しました.", vbExclamation

End Sub

'----------------- 標準モジュール ---------------------------------

Option Explicit

' ユーザーにもラインを消せるように、標準モジュールにおく
Sub Lines_Del()

　　Dim Wb　　　As Workbook
　　Dim Sh　　　As Worksheet
　　Dim shpLine As Shape
　　
　　On Error Resume Next
　　For Each Wb In Workbooks
　　　　For Each Sh In Wb.Worksheets
　　　　　　For Each shpLine In Sh.Shapes
　　　　　　　　If shpLine.Name Like "$CurLine_*" Then
　　　　　　　　　　shpLine.Delete
　　　　　　　　End If
　　　　　　Next shpLine
　　　　Next Sh
　　Next Wb

End Sub

pauNed · Answer

すみません。おすすめしないとはいえ、中途半端すぎました^ ^;
とりあえずZoom=100ならこれで大丈夫なはず。

Sub Lin_Cursor()
　　Dim Tn As Single, Ln As Single
　　Application.Cursor = xlNorthwestArrow
　　Application.StatusBar = "Lin_Cursor On"
　　Do
　　　　DoEvents
　　　　GetCursorPos MoP
　　　　With MoP
　　　　　Ln = (.x - ActiveWindow.PointsToScreenPixelsX _
　　　　　　　　(Range("A1").Left)) * 3 / 4
　　　　　Tn = (.y - ActiveWindow.PointsToScreenPixelsY _
　　　　　　　　(Range("A1").Top)) * 3 / 4
　　　　End With
　　　　If Not Lflg Then Exit Do
　　　　With ActiveSheet.Lines("line_H")
　　　　　　.Top = Tn
　　　　　　.Left = Ln - 1500
　　　　　　.Width = 3000
　　　　End With
　　　　With ActiveSheet.Lines("line_v")
　　　　　　.Top = Tn - 1000
　　　　　　.Left = Ln
　　　　　　.Height = 2000
　　　　End With
　　Loop
　　Application.Cursor = xlDefault
　　Application.StatusBar = False
End Sub

また、最低限↓これは必要でした。
'■ThisWorkbookモジュール
Private Sub Workbook_Deactivate()
　　解除
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
　　解除
End Sub

pauNed · Answer

こんにちは。サンプルですが、触りだけ^ ^

'■標準モジュールに
Option Explicit

Private Lflg As Boolean

Private Type POINTAPI
　　x As Long
　　y As Long
End Type

Private Declare Function GetCursorPos Lib _
　　　　　　"user32.dll" (lpPoint As POINTAPI) As Long

Private MoP As POINTAPI, GetX As Single, GetY As Single

Sub Lines_Add() 'LineShapeをつくる。初回のみ
　　With ActiveSheet
　　　　On Error Resume Next
　　　　.Lines("line_H").Delete
　　　　.Lines("line_V").Delete
　　　　On Error GoTo 0
　　　　With .Lines.Add(0, 0, 3000, 0)
　　　　　　.Name = "line_H"
　　　　　　With .ShapeRange.Line
　　　　　　　　.Weight = 1
　　　　　　　　.Style = msoLineSingle
　　　　　　　　.ForeColor.SchemeColor = 48
　　　　　　End With
　　　　End With
　　　　With .Lines.Add(0, 0, 0, 2000)
　　　　　　.Name = "line_V"
　　　　　　With .ShapeRange.Line
　　　　　　　　.Weight = 1
　　　　　　　　.Style = msoLineSingle
　　　　　　　　.ForeColor.SchemeColor = 48
　　　　　　End With
　　　　End With
　　End With
End Sub

Sub スタート()
　　Lflg = True
　　Lin_Cursor
End Sub

Sub 解除()'ボタンやショートカットキーやイベントに割り当てたり。
　　Lflg = False
End Sub

Sub Lin_Cursor() '本体。Constは環境によって調整必要。
　　Dim Tn As Single, Ln As Single
　　Const yi As Single = 103 'シート上のy座標の初期修正値。
　　Const xi As Single = 28 'シート上のx座標の初期修正値。
　　Const N As Single = 1.336 '係数のようなもの。
　　
　　Application.Cursor = xlNorthwestArrow
　　Application.StatusBar = "Lin_Cursor On"
　　Do
　　　　DoEvents
　　　　With ActiveWindow.VisibleRange
　　　　　　GetCursorPos MoP
　　　　　　Tn = (MoP.y - yi) / N + .Top
　　　　　　Ln = (MoP.x - xi) / N + .Left
　　　　End With
　　　　With ActiveSheet.Lines("line_H")
　　　　　　.Top = Tn
　　　　　　.Left = Ln - 1500
　　　　　　.Width = 3000
　　　　End With
　　　　With ActiveSheet.Lines("line_v")
　　　　　　.Top = Tn - 1000
　　　　　　.Left = Ln
　　　　　　.Height = 2000
　　　　End With
　　Loop Until Not Lflg
　　Application.Cursor = xlDefault
　　Application.StatusBar = False
End Sub

ウィンドウのサイズや位置の変更によって、またツールバーの高さによっても位置がずれますので、
少し工夫が必要ですね。
DoLoopで常にマクロ実行しているわけですから、CPU負担も高いし、
入力時には解除しないといけないので基本的にはおすすめしません。

MauseMoveではなくて、Cell選択時の動作でよければWorksheet_SelectionChangeを使って、
A)条件付き書式と組み合わせる方法。
B)Lineシェイプを使う方法。
などがあります。特定のシートだけなら比較的簡単です。
参考URLのリンク先も辿ってみてください。

参考URL：http://park7.wakwak.com/~efc21/cgi-bin/wwwlng.cgi?print+200607/06070180.txt

エクセルの表に数字を入力するときに行と列に色をつける！！

こんにちは。

こんにちは。

こんにちは。

すみません。

こんにちは。

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング