セコンド

セコンドのソースコードです。

いつもの通り、最低限の機能を実装しているだけですので、皆さんのアイデアを具体化してください。

Option Explicit

'UserForm1との受け渡し用
Public ADD_COND As Boolean


'色を返してくれるプロパティ
Property Get Get_Color(id As String) As Long

  Select Case (id)
    Case "1": Get_Color = vbRed
    Case "2": Get_Color = vbBlue
    Case "3": Get_Color = vbMagenta
    Case Else: Get_Color = vbRed
  End Select

End Property


'セルコン本体
Sub Add_Cell_Condition()

  '条件追加はしないという初期設定にしておく
  ADD_COND = False
  
  '現在のセルの位置情報を取得
  Dim c_loc As String
  c_loc = Selection.Address

  'まず色を選択 (赤、青、黄)
  Dim sel_col As String
  sel_col = InputBox("1:赤、2:青、3:マゼンタ")

  '背景か枠かを選択
  Dim sel_disp As String
  sel_disp = InputBox("1:背景、2:枠")

  '一致か不一致か
  Dim sel_cond As String
  sel_cond = InputBox("1:不一致、2:一致")

  '比較対象のセルを取得
  UserForm1.Show (vbModeless)

  'UserForm1が表示されいる間は処理が進まないようにしてループしておく
  Do Until UserForm1.Visible = False
    DoEvents
  Loop
 
  'UserForm1からOKポタンがクリックされたことを確認する
  If ADD_COND Then
    '枠を選択
    If sel_disp = 2 Then
      Call Make_Waku(c_loc, Selection.Address, Get_Color(sel_col), sel_cond)
    '背景色を選択
    Else
      Call Make_Back(c_loc, Selection.Address, Get_Color(sel_col), sel_cond)
    End If
  End If

End Sub

'条件付き書式で、セルの罫線(枠)を作る
Private Sub Make_Waku(src As String, dst As String, col As Long, cond As String)

  '一致で背景色を出すか、不一致で出すかの設定
   Dim cond_op As Long
   If cond = 2 Then
     cond_op = xlEqual
   Else
     cond_op = xlNotEqual
   End If


  '罫線の設定
   With Range(src)
     '条件を付加
     .FormatConditions.Add Type:=xlCellValue, Operator:=cond_op, _
         Formula1:="=" & dst
     '.FormatConditions(.FormatConditions.Count).SetFirstPriority
     With .FormatConditions(1).Borders
        .LineStyle = xlContinuous '線種
        .Color = col              '色
        .TintAndShade = 0         '明るさ
        .Weight = xlThin          '線幅
     End With
     .FormatConditions(1).StopIfTrue = False
  End With

End Sub


'条件付き書式で、セルの背景色を作る
Private Sub Make_Back(src As String, dst As String, col As Long, cond As String)

  '一致で背景色を出すか、不一致で出すかの設定
  Dim cond_op As Long
  If cond = 2 Then
    cond_op = xlEqual
  Else
    cond_op = xlNotEqual
  End If
   
  '背景の設定
  With Range(src)
     '条件を付加
     .FormatConditions.Add Type:=xlCellValue, Operator:=cond_op, _
        Formula1:="=" & dst
     
     '条件の優先度を設定
     '.FormatConditions(.FormatConditions.Count).SetFirstPriority
     With .FormatConditions(1).Interior
       .PatternColorIndex = xlAutomatic
       .Color = col
       .TintAndShade = 0
     End With
     .FormatConditions(1).StopIfTrue = False
  End With

End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

Option Explicit

'UserForm1との受け渡し用

Public ADD_COND As Boolean

'色を返してくれるプロパティ

Property Get Get_Color(id As String) As Long

Select Case (id)

Case "1": Get_Color = vbRed

Case "2": Get_Color = vbBlue

Case "3": Get_Color = vbMagenta

Case Else: Get_Color = vbRed

End Select

End Property

'セルコン本体

Sub Add_Cell_Condition()

'条件追加はしないという初期設定にしておく

ADD_COND = False

'現在のセルの位置情報を取得

Dim c_loc As String

c_loc = Selection.Address

'まず色を選択 (赤、青、黄)

Dim sel_col As String

sel_col = InputBox("1:赤、2:青、3:マゼンタ")

'背景か枠かを選択

Dim sel_disp As String

sel_disp = InputBox("1:背景、2:枠")

'一致か不一致か

Dim sel_cond As String

sel_cond = InputBox("1:不一致、2:一致")

'比較対象のセルを取得

UserForm1.Show (vbModeless)

'UserForm1が表示されいる間は処理が進まないようにしてループしておく

Do Until UserForm1.Visible = False

DoEvents

Loop

'UserForm1からOKポタンがクリックされたことを確認する

If ADD_COND Then

'枠を選択

If sel_disp = 2 Then

Call Make_Waku(c_loc, Selection.Address, Get_Color(sel_col), sel_cond)

'背景色を選択

Else

Call Make_Back(c_loc, Selection.Address, Get_Color(sel_col), sel_cond)

End If

End Sub

'条件付き書式で、セルの罫線(枠)を作る

Private Sub Make_Waku(src As String, dst As String, col As Long, cond As String)

'一致で背景色を出すか、不一致で出すかの設定

Dim cond_op As Long

If cond = 2 Then

cond_op = xlEqual

Else

cond_op = xlNotEqual

End If

'罫線の設定

With Range(src)

'条件を付加

.FormatConditions.Add Type:=xlCellValue, Operator:=cond_op, _

Formula1:="=" & dst

'.FormatConditions(.FormatConditions.Count).SetFirstPriority

With .FormatConditions(1).Borders

.LineStyle = xlContinuous '線種

.Color = col '色

.TintAndShade = 0 '明るさ

.Weight = xlThin '線幅

End With

.FormatConditions(1).StopIfTrue = False

End With

End Sub

'条件付き書式で、セルの背景色を作る

Private Sub Make_Back(src As String, dst As String, col As Long, cond As String)

'一致で背景色を出すか、不一致で出すかの設定

Dim cond_op As Long

If cond = 2 Then

cond_op = xlEqual

Else

cond_op = xlNotEqual

End If

'背景の設定

With Range(src)

'条件を付加

.FormatConditions.Add Type:=xlCellValue, Operator:=cond_op, _

Formula1:="=" & dst

'条件の優先度を設定

'.FormatConditions(.FormatConditions.Count).SetFirstPriority

With .FormatConditions(1).Interior

.PatternColorIndex = xlAutomatic

.Color = col

.TintAndShade = 0

End With

.FormatConditions(1).StopIfTrue = False

End With

End Sub

MENU

VBA関連

VBA関連