[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『選択行全体に色をつけたいのですが教えて下さい』(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]] 『セルを位置づけた行全体の色をつける』(C36AMG)
一旦シート全体の色を消しますので元々色つきセルがある場合は不向きです。
条件付き書式+シートのイベントを使った方法です。 一旦セルの条件付き書式を削除しますので条件付き書式が設定されているセル がある場合は不向きです。
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
×シートモジュールに ○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 の数値をいろいろ変えてみたのですがここで指定して いるのではない?様です。
まったくの新米ですのでよろしくお願いします。
便乗質問NGでしたらお詫びします。
よろしくお願いします。。。。
(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
色のついての参考HPです。
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 にして、A1セルに好きな書式を設定することで選択行がその色になりました。
特定のセルに条件付き書式を設定してもそれはそのままでいるようです。
横から飛び込み失礼しました。
ありがとうございました、、、
今後ともよろしくお願いします。
(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
カリーニン さまの方法でも ??? さまの方法でもうまくいきました。
たびたび厚かましいのですが、行全部着色ではなく一定の列まで、例えば列Mまで着色という方法を
お教え願いたいのですが。
よろしくお願いします。
(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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.