セルの選択でその行に色を付けたい

質問

横に長いデータがあり、その1つのセルを選択するとその行全体に色が付くようにしたいのです。過去の質問で以下のようなものを見つけましたが、問題はその場合、通常のコピー→貼り付けができない点です。
その辺を問題なく行える方法はないでしょうか？
よろしくお願いいたします。

Public m, n
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If m <> 0 Then
Range(Cells(m, 1), Cells(m, 256)).Interior.ColorIndex = n
End If
m = Target.Row
n = Target.Interior.ColorIndex
Range(Cells(Target.Row, 1), Cells(Target.Row, 256)).Interior.ColorIndex = 6

End Sub

回答No.9

ka_na_de · ベストアンサー

＃２です。

＃８のコードを実行するためには、以下を行ってください。

ＶＢＥの上部のメニュから
「ツール」→「参照設定」をクリックし、
「Microsoft Forms 2.0 Object Library」にチェックを入れて「ＯＫ」

お礼

皆さんのおかげで完成しました！！
本当にありがとうございました！！

回答No.8

ka_na_de

＃２です。

これでどうでしょうか？

Public m, n
Private Declare Function EmptyClipboard Lib "User32" () As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　　Dim myDataObj As DataObject
　　Dim myStr As String
　　Dim myCCMode As Boolean
　　Dim ret As Long

　　On Error Resume Next
　　myCCMode = Application.CutCopyMode
　　If myCCMode = True Then
　　　　Set myDataObj = New DataObject
　　　　myDataObj.GetFromClipboard
　　　　myStr = myDataObj.GetText
　　　　ret = EmptyClipboard()
　　End If

　　Application.EnableEvents = False
　　If m <> 0 Then
　　　　Range(Cells(m, 1), Cells(m, 256)).Interior.ColorIndex = n
　　End If
　　m = Target.Row
　　n = Target.Interior.ColorIndex
　　Range(Cells(Target.Row, 1), Cells(Target.Row, 256)).Interior.ColorIndex = 6
　　Target.Interior.ColorIndex = n
　　Application.EnableEvents = True

　　If myStr <> "" Then
　　　　myDataObj.SetText myStr
　　　　myDataObj.PutInClipboard
　　End If

　　Application.CutCopyMode = myCCMode
　　Set myDataObj = Nothing

End Sub

回答No.7

rivoisu

ka_na_deさんありがとうございます。

用途は理解できました。
多くの列がある表に入力するときに入力する人が間違えなくするための工夫ですね。

＞通常のコピー→貼り付けができない点です。
通常のコピー貼り付けは問題なくできます。

問題はコピー元にカーソルを合わせるとそこが色付けされ目的のセル（コピー先）から色付けのライｆが消えるので見失いやすいということでしょうか。

ということでしたらコピー先に移動する前にコピーもとで何らかの操作をしてそのイベントによりコピー先をメモって置く必要がありそうです。
さてその「何らかの操作」をどうするか
セル選択をおもに「マウス」を使う人でしたら「ダブルクリック」
キーボードを使う人でしたらCtrl+キー（例ではCtrl+qとしています）
そうすると操作の手順はつぎのようになります。

入力するセルでどちらかの操作を行う。（ダブルクリック　Or　Ctrl+q　そのセルの色が変わる）
コピー元にカーソルを移動する
コピーする。（Ctrl+c）
コピー先へカーソルを合わせる。（色を目標にする）
ペースト（Ctrl+v)

という操作になります。
こういう解釈でいいでしょうか？

お礼

皆さんのおかげで完成しました！！
本当にありがとうございました！！

回答No.6

ka_na_de

rivoisu様へ

ka_na_deです。

もっといい方法があるかもしれませんが、
以下は私の方法です。

結論からいうと、「全角の空白」で字下げしています。

私の場合、VBEでコードを記述するときはタブで字下げしています。
このコードをテキストエディターにコピペします。
私は、サクラエディタというフリーソフトを使っていますが、
これにコピペするとタブが半角空白４文字に変換されます。

そこで、サクラエディタの置換機能を使って、
半角空白４文字を全角空白２文字に変換します。

こうしてできたコードを、こちらの回答フォームにコピペしています。

ちなみに、逆に全角空白の入ったコードをVBEに貼り付ける場合は
自動的に半角空白に変換されるようですね。

ponpa22様へ　
先ほどは質問の意図をあまり良く理解せずに誤回答してしまいました。
おそらく、クリップボードの内容を一旦確保するような処理
を行えば良いのだと思いますが、私には役不足です。
他の詳しい方の回答を待ちたいと思います。

回答No.5

rivoisu

すみません回答ではありません

ka_na_deさんの回答でコードを書かれているなかでちゃんと字下げがされてますが
どのようにされているのですか私もコードを回答欄に記述することがあるのですが
行頭の半角スペースは削除されてしまいます。

横からすみませんが教えてください。

回答No.4

hallo-2007

>横に長いデータで、その端に新たに入力する時に、目視で確認を間違えないようにしたいんです。
でしたら
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
With Target
Range(.EntireRow.Address).Select
.Activate
End With
Application.EnableEvents = True
End Sub
では如何でしょうか。

お礼

皆さんのおかげで完成しました！！
本当にありがとうございました！！

補足

ありがとうございます。
ただ、これですと、1つのセルのみのコピー→貼り付けができず、その行すべてが貼り付いてしまうのですが…

回答No.3

ka_na_de

＃２です。

ごめんなさい。とんちんかんな回答でした。
前の回答は無視してください。

回答No.2

ka_na_de

他の人が作ったコードに加筆するのは
気が進みませんが、以下でどうでしょうか？

Public m, n
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　　If m <> 0 Then
　　　　Range(Cells(m, 1), Cells(m, 256)).Interior.ColorIndex = n
　　End If
　　m = Target.Row
　　n = Target.Interior.ColorIndex
　　Range(Cells(Target.Row, 1), Cells(Target.Row, 256)).Interior.ColorIndex = 6
　　Target.Interior.ColorIndex = n '新たに加えた部分
End Sub

回答No.1

rivoisu

そのコードはセルを選択するたびに起動します。

セルを選択するたびに今までの行の色を消して新しく選択された行に色をつけるというコードになっています。
ただそれだけでコピー、はりつけも問題なくできます。
問題はあなたがどのタイミングで色をつけたいか、、消したいかです。

そもそ何のためにそういうことをする必要ががあるのですか（悪い意味にとらないでね、本当に知りたいのです）
教えてください。

補足

早速ありがとうございます。
横に長いデータで、その端に新たに入力する時に、目視で確認を間違えないようにしたいんです。
よろしくお願いします。