[[20141011233727]]　『選択行全体に色をつけたいのですが教えて下さい』（taronippon）　ページの最後に飛ぶ

『選択行全体に色をつけたいのですが教えて下さい』（taronippon）

表が横に長いので　いまどこの行を見ているのか判らない場合があります。
一度、ご紹介頂きましたが、その行からカーソル移動で下へ移動すると
　前の選択セル行の残色が残り、エンター実行して初めてそのセル行が
　変わります。そうではなく　カーソル移動でも変化する方法を教えて下さい
ぜひどのファイルでも使えるようなマクロ・アドインを
　紹介して頂けませんでしょうか
　よろしく、お願い致します。
　

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

 >一度、ご紹介頂きましたが、その行からカーソル移動で 下へ移動すると 
 >前の選択セル行の残色が残り、エンター実行して初めてそのセル行が 
 >変わります。

 そのコードは提示できませんか？
（カリーニン） 2014/10/12(日) 00:23

 こんばんは
 条件付き書式ではどうでしょうか？

 表全体を選択した状態で→条件付き書式→新しいルール
 →数式を使用

 =CELL("row")=ROW()

 書式→塗りつぶし→色選択→OK
（五線譜） 2014/10/12(日) 00:38

ありがとうございます
実は、この方式だと常に条件設定が必要であり不便です
　どのファイル等でも使えるマクロ形式はないものでしょうか
友達もタブレットで表を表示するとどこか分からず
　ぜひ教えて下さい

現在使用は→「数式が」を選択して、「=ROW(A3)=CELL("row")」　
すみません

（taronippon） 2014/10/12(日) 00:42

 シートのイベントでアクティブセルの行全体に色を付けます。

[[20090430133425]]　『セルを位置づけた行全体の色をつける』（Ｃ３６ＡＭＧ）

 一旦シート全体の色を消しますので元々色つきセルがある場合は不向きです。

 条件付き書式+シートのイベントを使った方法です。
 一旦セルの条件付き書式を削除しますので条件付き書式が設定されているセル
 がある場合は不向きです。

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim r As Range
   Set r = Target
   r.FormatConditions.Delete
   r.FormatConditions.Add Type:=xlExpression, Formula1:= _
    "=CELL(""address""," & r.Resize(1, 1).Address(0, 0) & ")=CELL(""address"")"
   r.FormatConditions(1).Interior.ColorIndex = 3
   Calculate
 End Sub
（カリーニン） 2014/10/12(日) 01:42

失礼いたしました。

 下記コードをThisWorkbookモジュールに貼り付けてください。

 Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  Sh.Cells.Interior.ColorIndex = xlNone
  Dim i As Long
  i = Target.Row
  Rows(i).Interior.ColorIndex = 6
 End Sub

（五線譜） 2014/10/12(日) 01:47

五線譜さんの00：38の条件付き書式は

 ×シートモジュールに
 ○ThisWorkbookモジュールに ※2：18修正

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

 とすることで旨く行きます。
（カリーニン） 2014/10/12(日) 01:51

 五線譜さんご提示の

 Workbook_SheetSelectionChange

 を使った方法です。

 シート切替の度にアクティブシート全体に条件付き書式を設定しなおします。
 マクロの自動記録のコードを流用しましたので無駄な部分があるかもしれませんが。

 Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  With ActiveSheet.Cells
   .FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=CELL(""row"")=ROW()"
   .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
   With .FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent5
    .TintAndShade = 0.599963377788629
   End With
   .FormatConditions(1).StopIfTrue = False
  End With
 End Sub

 Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  Calculate
 End Sub
（カリーニン） 2014/10/12(日) 02:03

早速実行してみます
有難う御座いました。
（taronippon） 2014/10/12(日) 08:17

 元々の質問の

 >一度、ご紹介頂きましたが、その行からカーソル移動で 下へ移動すると 
 >前の選択セル行の残色が残り、エンター実行して初めてそのセル行が 
 >変わります。

 これは↓を入れることで改善したと思います。ですので

 >そのコードは提示できませんか？

 と書きました。

 Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  Calculate
 End Sub
（カリーニン） 2014/10/12(日) 09:44

 条件付き書式が設定されていても追加されてしまうのを回避するコードの追加と
 ActiveSheetをShに置き換える変更を行いました。

 Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  If Sh.Cells(1, 1).FormatConditions.Count <> 0 Then Exit Sub
  With Sh.Cells
   .FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=CELL(""row"")=ROW()"
   .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
   With .FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent5
    .TintAndShade = 0.599963377788629
   End With
   .FormatConditions(1).StopIfTrue = False
  End With
 End Sub
（カリーニン） 2014/10/13(月) 00:34

ここは便乗質問はＮＧでしょうか、、、
もしできましたら、お教え願いたいのですが、、、、
「選択行に色を、、、、｝このようなものを希望していたのですが、見つけられませんでした。
選択行を指定した時、色は指定できないでしょうか、今回紹介のものは行番号をクリックしたときと
同じ？ような色ですが、これをもっと淡い色で表示したいのです。

    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent5
    .TintAndShade = 0.599963377788629　　の数値をいろいろ変えてみたのですがここで指定して
いるのではない？様です。

まったくの新米ですのでよろしくお願いします。

便乗質問ＮＧでしたらお詫びします。
よろしくお願いします。。。。

（YNo） 2014/10/14(火) 17:51

 If Sh.Cells(1, 1).FormatConditions.Count <> 0 Then Exit Sub

 これがあるせいだと思います。
 既にA1セルに条件付き書式が設定されていると条件付き書式の設定が付加
 されません。

 ↓のように変えてみてください。

 If Sh.Cells(1, 1).FormatConditions.Count <> 0 Then Sh.Cells.FormatConditions.Delete
（カリーニン） 2014/10/14(火) 22:43

 色のついての参考ＨＰです。

http://www.happy2-island.com/excelsmile/smile03/capter00608.shtml
（カリーニン） 2014/10/14(火) 22:49

カリーニンさま

ありがとうございました。
よく理解できてはいないのですが、、、

If Sh.Cells(1, 1).FormatConditions.Count <> 0 Then Sh.Cells.FormatConditions.Delete にして、Ａ１セルに好きな書式を設定することで選択行がその色になりました。
特定のセルに条件付き書式を設定してもそれはそのままでいるようです。

横から飛び込み失礼しました。
ありがとうございました、、、
今後ともよろしくお願いします。

（YNo） 2014/10/15(水) 19:04

皆様本当に有難う御座います。
私素人では結果として、何もできませんでした
条件付き書式を設定してますので、全部クリアーになりました

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Cells.Interior.ColorIndex = xlNone
    Rows(Target.Row).Interior.ColorIndex = 35
友人よりも教えて頂きましたが、上記では簡単ですが
　条件付き書式が全部消えます
教えて下さい
また、シート貼り付けでなく、マクロでは出来ないでしょうか
　アドインとか・・・・
よろしく、お願い致します。
　素人 Taro Nippon

 Dim R As Range

 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If Not R Is Nothing Then
        R.Interior.ColorIndex = xlNone
        Set R = Nothing
    End If
 End Sub

 Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Not R Is Nothing Then
        R.Interior.ColorIndex = xlNone
    End If
    Sh.Rows(Target.Row).Interior.ColorIndex = 35
    Set R = Sh.Rows(Target.Row)
 End Sub
（???） 2014/10/16(木) 10:45

着色ではなく、図形を移動させて表現してみる例。（シートモジュールに記述）

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim i As Long
    Dim iFlag As Long

    For i = 1 To Shapes.Count
        If Shapes(i).Name = "矢印" Then
            With Shapes("矢印")
                .Top = Target.Top
                .Left = 0
                .Width = 20
                .Height = Target(0).Height
            End With
            iFlag = 1
            Exit For
        End If
    Next i

    If iFlag = 0 Then
        With Shapes.AddShape(msoShapeRightArrow, 0, Target.Top, 20, Target(0).Height)
            .Name = "矢印"
        End With
    End If
 End Sub
（???） 2014/10/16(木) 11:09

taronippon　さま、また、横から失礼します。

カリーニン　さまの方法でも　？？？　さまの方法でもうまくいきました。
たびたび厚かましいのですが、行全部着色ではなく一定の列まで、例えば列Ｍまで着色という方法を
お教え願いたいのですが。

よろしくお願いします。

（YNo） 2014/10/16(木) 16:22

 Dim R As Range

 Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Not R Is Nothing Then
        R.Interior.ColorIndex = xlNone
    End If
    Sh.Range(Sh.Cells(Target.Row, "A"), Sh.Cells(Target.Row, "M")).Interior.ColorIndex = 35
    Set R = Sh.Range(Sh.Cells(Target.Row, "A"), Sh.Cells(Target.Row, "M"))
 End Sub
（???） 2014/10/16(木) 16:43

？？？　さま

素早い回答ありがとうございます。
ばっちりです。。。。。
矢印も面白いですが、今回は最後のお教えを使用させていただきます。

taronippon さま、割り込み失礼しました。カリーニン様の方法でも、？？？様の方法でも上手くいくと
思います。トライしてください。

？？？さま　カリーニンさま　ありがとうございました。。。
ロートルですがボケ防止に挑戦しています。今後ともよろしくお願いします。

有難うございました。。

（YNo） 2014/10/16(木) 17:52

 アドインの作成方法をリンクしておきます。

http://excel.syogyoumujou.com/vba/addin.html

 全てのブックに対して処理が行われますので、熟慮の上アドイン登録してください。
 特に、今回のような場合、実行内容によっては、既存のセルの背景色、条件付き書式に
 影響が出る可能性がありますので注意が必要です。
（カリーニン） 2014/10/16(木) 23:47

 >カーソル移動でも変化する方法を教えて下さい 
 >ぜひ どのファイルでも使えるようなマクロ・アドインを

 特定ブックだけ選択されたセルのある行に色を付ける　という仕様なら、既に提示されているような方法で
 十分なのですが、
 アドインとして、汎用的にこの機能を提供するとなると、色々と考えてしまいますねえ！！

 私も ???さんの図形を使った方法で試してみました。

 新規ブックのThisworkbookのモジュールに

 '==========================================================================================
 Option Explicit
 Const s_lnm = "選択された行に四角形を作成する"
 Private WithEvents app As Application
 Private Sub app_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim i As Long
    Dim iFlag As Long
    Dim rng As Range
    Dim s_ln As Rectangle
    Set rng = app.ActiveWindow.VisibleRange
    On Error Resume Next
    Set s_ln = Sh.Rectangles(s_lnm)
    Set Target = ActiveCell.MergeArea
    If Err.Number <> 0 Then
       Set s_ln = Sh.Rectangles.Add(rng.Left, Target.Top, rng.Width, Target.Height)
       With s_ln
          .Name = s_lnm
          .Border.Color = vbCyan
          .Interior.Color = vbCyan
          .ShapeRange.Fill.Transparency = 0.8
       End With
    Else
       With s_ln
          .Left = rng.Left
          .Top = Target.Top
          .Width = rng.Width
          .Height = Target.Height
          .Border.Color = vbCyan
          .Interior.Color = vbCyan
          .ShapeRange.Fill.Transparency = 0.8
       End With
    End If
 End Sub
 '==========================================================================================
 Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Set app = Nothing
 End Sub
 '==========================================================================================
 Private Sub Workbook_Open()
    Set app = Application
 End Sub

 これをアドインとして、保存し、Excelを立ち上げなおして、アドインとして、登録してください。

 これで、どのブックでも選択行に色のついた図形が作成されます。
 問題点は、シート保護などしていると、エラーが発生しますが・・・。

 アドインとして登録する場合、カリーニンさんも

 >全てのブックに対して処理が行われますので、熟慮の上アドイン登録してください。

 と懸念事項をあげておられますが、冒頭にも記述しましたが、

 汎用的にある機能を提供するとなると、特定ブックなら、そんなに考えなくても良いことでも
 考慮しなければならない点がでてきます。

 1　不特定ブックへの処理
    アドインで不特定のブックにプログラムで処理させるのは、大変です。
    相手側のブックが想定外の設定が施されている場合もありますからねえ。

    例えば、シート保護がされていた場合でも何らかの対処ができるか（エラーが発生しないようになっているか？）

 2　処理を行うための登録

    どのブックでも処理するといっても　行の色付けなんて要らない　というブックもありますから、
    アドイン側からアクティブブックに対して何らかの登録を行い、
    結果、何かの識別子で行の色付けを行う、行わないを判断する必要がありますよね？

 3　登録の解除

    登録があるなら、解除もアドインの機能として作成しなければなりませんよね！！
    この時、識別子の削除は、当たり前ですが、行の色付けを提供していた設定をブックから、
    抹消する必要もありますよね。図形の削除や条件付き書式の削除等・・・。
    立つ鳥跡を濁さず　ですからねえ。

 簡単なようで厄介な問題もありそうですよね？

 尚、投稿したコードは、これらの事は、考慮していません

（ ichinose） 2014/10/18(土) 09:47

 元々の
 >表が横に長いので　いまどこの行を見ているのか判らない場合があります。
 に限定して言えば、データフォームを使う、という手もあります。

http://edutainment-fun.com/excel/tool/form.html
（カリーニン） 2014/10/18(土) 10:25

コメント返信：

[ 一覧(最新更新順) ]

[[20141011233727]] 『選択行全体に色をつけたいのですが教えて下さい』（taronippon） ページの最後に飛ぶ

[[20141011233727]]　『選択行全体に色をつけたいのですが教えて下さい』（taronippon）　ページの最後に飛ぶ