[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『列方向に対しての色付き枠線の検索方法』(とあ)
単独セル、結合セルが混ざった表があるとします。
またその表は、黒の枠線が引かれております。(外枠だけでなく全て)
そこで、セルをクリックするとクリックしたセルの枠が赤くなるようにしてあります。
ここからが質問の内容になるのですが、
セルをクリックした際に、その列に既に赤枠になっているセルが存在する場合、
その赤枠を黒枠に直し、クリックしたセルを赤枠にする
ということはできませんか?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
でマクロ実行されるため、クリック後の状態を確保しておくことが出来ないと思われ、セルがクリックされるたびの確認しかないかなと思っています。
だが、クリックした列に対し、単独セルおよび結合セルが赤枠になっているかの検索方法がわからず、どなたか教えて頂けたらと思います。
< 使用 Excel:Excel2013、使用 OS:Windows7 >
枠線が罫線だとして、案だけで良ければ、ぱっと2つほど思いつきます。
(1)シート全てのセルを調べて、罫線があれば全部黒くしてから、現在の方法で赤くする。
(2)赤くする際、そのセル範囲を共通変数に覚えておき、前回塗ったセルがあるならそこを黒にしてから、現在の方法で赤くする。
枠線が矩形オブジェクトなら、新たにオブジェクトを置くのではなく、1つの赤枠オブジェクトの座標を変えるだけの事でしょう。
(???) 2019/12/25(水) 09:35
書式の検索は、マクロの記録でできますよね 検索する書式の指定は、Application.FindFormatプロパティです。
罫線だと面倒なので、塗りつぶしのサンプルです。
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Static previousTarget As Range
If Not previousTarget Is Nothing Then previousTarget.Interior.ColorIndex = xlNone End If
Target.Interior.ColorIndex = 3
Set previousTarget = Target
End Sub (´・ω・`) 2019/12/25(水) 09:42
そして、シート全てのセルに枠線がついているのではなく、
A列〜K列のように、ある特定の場所に表が作成され
その表全体に枠線がついている状態です。
(2)赤くする際、そのセル範囲を共通変数に覚えておき、前回塗ったセルがあるならそこを黒にしてから、現在の方法で赤くする。
⇒セルがクリックされるたびにマクロが実行されますが、マクロ終了後、再度他のセルをクリックしたらマクロが実行されますが、前の情報を覚えておくことなどできるのですか?
If Cells(Target.Row, Target.column).MergeCells Then '選択したセルが結合セルの場合
area = Cells(Target.Row, Target.column).MergeArea.address '結合セルの範囲を取得 Range(area).Borders(xlEdgeTop).Color = RGB(255, 0, 0) Range(area).Borders(xlEdgeBottom).Color = RGB(255, 0, 0) Range(area).Borders(xlEdgeLeft).Color = RGB(255, 0, 0) Range(area).Borders(xlEdgeRight).Color = RGB(255, 0, 0) Else Cells(Target.Row, Target.column).Borders(xlEdgeTop).Color = RGB(255, 0, 0) Cells(Target.Row, Target.column).Borders(xlEdgeBottom).Color = RGB(255, 0, 0) Cells(Target.Row, Target.column).Borders(xlEdgeLeft).Color = RGB(255, 0, 0) Cells(Target.Row, Target.column).Borders(xlEdgeRight).Color = RGB(255, 0, 0) End If
(とあ) 2019/12/25(水) 09:51
ただし、条件付き書式を使った時の罫線は細罫線しかなく、
しかも現在位置を示すカーソルのほうが目立つため、
赤罫線が見えません。(現状のコードもそのように思われる)
塗りつぶしとかを使ったほうが目立つのではないかと思います。
(*)当該セルだけなら、条件式は
=AND(CELL("row")=ROW(),CELL("col")=COLUMN())
となります。
(γ) 2019/12/25(水) 10:21
1番はお手軽ですが、既に黒罫線とか利用していると一緒に消してしまうので、使いにくそう。
(元コードも同じですが)
2番は、ブックを保存してしまうと、開きなおしたときに前回値が判らないので消されない問題あり。 実用するには、どこかのセルにAddressとして書き出しておくとか、追加対策が必要。
3番の、矩形オブジェクトを使うのが安全に思いますが、いかがでしょうか。
(1)罫線全部消す
Private Sub Worksheet_Change(ByVal Target As Range) Target.CurrentRegion.Cells.Borders.Color = xlNone With Target.MergeArea .Borders(xlEdgeTop).Color = RGB(255, 0, 0) .Borders(xlEdgeBottom).Color = RGB(255, 0, 0) .Borders(xlEdgeLeft).Color = RGB(255, 0, 0) .Borders(xlEdgeRight).Color = RGB(255, 0, 0) End With End Sub
(2)前回のセルを覚えておく
【標準モジュール】 Public R As Range
【シートモジュール】 Private Sub Worksheet_Change(ByVal Target As Range) If Not R Is Nothing Then R.MergeArea.Borders.Color = xlNone End If With Target.MergeArea .Borders(xlEdgeTop).Color = RGB(255, 0, 0) .Borders(xlEdgeBottom).Color = RGB(255, 0, 0) .Borders(xlEdgeLeft).Color = RGB(255, 0, 0) .Borders(xlEdgeRight).Color = RGB(255, 0, 0) End With Set R = Target End Sub
(3)矩形オブジェクトで罫線引く
Private Sub Worksheet_Change(ByVal Target As Range) Dim S As Shape
With Target.MergeArea For Each S In ActiveSheet.Shapes If S.Name = "枠" Then S.Left = .Left S.Top = .Top S.Width = .Width S.Height = .Height Exit Sub End If Next S
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height) .Name = "枠" .Fill.Visible = msoFalse .Line.ForeColor.RGB = RGB(255, 0, 0) End With End With End Sub (???) 2019/12/25(水) 11:40
>セルをクリックするとクリックしたセルの枠が赤くなるようにしてあります。
提示のコードってSelectionChangeイベントで書いてたりしませんかね?
上記2つがいずれもYESなら、こうしたらどうでしょうか?
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim 表範囲 As Range: Set 表範囲 = Range("A2:K100")
'▼選択(されてアクティブになった)セルが表の範囲内か判定 If Intersect(表範囲, ActiveCell.MergeArea) Is Nothing Then Exit Sub
'▼選択(されてアクティブになった)セルが含まれる列【全部】の罫線の色をデフォルトにする With Intersect(表範囲, ActiveCell.MergeArea.EntireColumn) .Borders.ColorIndex = xlAutomatic End With
'▼選択(されてアクティブになった)セル【のみ】罫線の色を赤にする With ActiveCell.MergeArea .Borders(xlEdgeTop).Color = RGB(255, 0, 0) .Borders(xlEdgeBottom).Color = RGB(255, 0, 0) .Borders(xlEdgeLeft).Color = RGB(255, 0, 0) .Borders(xlEdgeRight).Color = RGB(255, 0, 0) End With End Sub
(もこな2 ) 2019/12/25(水) 12:10
With Target.MergeArea ↓ With Range(Cells(Target.Row, Target.Column).Address).MergeArea (???) 2019/12/25(水) 18:09
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.