Patternの見本

Patternの見本をつくります。

コードはこちら

Sub macro100328a()
'Pattern見本
    SheetAddCDel ("Pattern見本")
    Dim i As Integer
    Dim ValuePattern, StrPattern
    ValuePattern = Array(xlPatternAutomatic, xlPatternChecker, _
        xlPatternCrissCross, xlPatternDown, xlPatternGray16, _
        xlPatternGray25, xlPatternGray50, xlPatternGray75, _
        xlPatternGray8, xlPatternGrid, xlPatternHorizontal, _
        xlPatternLightDown, xlPatternLightHorizontal, _
        xlPatternLightUp, xlPatternLightVertical, xlPatternNone, _
        xlPatternSemiGray75, xlPatternSolid, xlPatternUp, _
        xlPatternVertical)

    StrPattern = Array("xlPatternAutomatic", "xlPatternChecker", _
        "xlPatternCrissCross", "xlPatternDown", "xlPatternGray16", _
        "xlPatternGray25", "xlPatternGray50", "xlPatternGray75", _
        "xlPatternGray8", "xlPatternGrid", "xlPatternHorizontal", _
        "xlPatternLightDown", "xlPatternLightHorizontal", _
        "xlPatternLightUp", "xlPatternLightVertical", "xlPatternNone", _
        "xlPatternSemiGray75", "xlPatternSolid", "xlPatternUp", _
        "xlPatternVertical")
       
    Cells(1, 2) = "表示"
    Cells(1, 4) = "Pattern"
       
    For i = 0 To 19
        Range("B" & 3 + 2 * i).Interior.Pattern = ValuePattern(i)
        Range("C" & 3 + 2 * i) = i
        Range("D" & 3 + 2 * i) = StrPattern(i)
    Next i
End Sub

実行後のシート

画面で見る分には、カラーでも問題ないですが、
印刷を白黒でする場合のセルの背景は
色よりもパターンの方が見やすいかもしれません。

そこで、色をパターンで置き換えたいと思います。

アクティブシートの使用範囲内のセルを調べて、
指定したColorIndexの背景を持つセルを
指定したパターンに置き換えます。

逆もあります。

コードはこちら

Sub macro100328b()
'ColorToPattern使用例
    Call ColorToPattern(38, 1)
End Sub

Sub ColorToPattern(C As Integer, i As Integer)
'セルの背景を色の塗りつぶしから
'白黒パターンへ変換
'C = ColorIndexを指定
'i = Patternを入れた配列のインデックスを指定

    Dim obj As Object
    Dim ValuePattern As Variant
    ValuePattern = Array(xlPatternAutomatic, xlPatternChecker, _
        xlPatternCrissCross, xlPatternDown, xlPatternGray16, _
        xlPatternGray25, xlPatternGray50, xlPatternGray75, _
        xlPatternGray8, xlPatternGrid, xlPatternHorizontal, _
        xlPatternLightDown, xlPatternLightHorizontal, _
        xlPatternLightUp, xlPatternLightVertical, xlPatternNone, _
        xlPatternSemiGray75, xlPatternSolid, xlPatternUp, _
        xlPatternVertical)
       
    For Each obj In ActiveSheet.UsedRange
        If obj.Interior.ColorIndex = C Then
            obj.Interior.ColorIndex = xlNone
            obj.Interior.Pattern = ValuePattern(i)
        End If
    Next obj
End Sub

Sub macro100328c()
'PatternToColorの使用例
    Call PatternToColor(1, 38)
End Sub

Sub PatternToColor(i As Integer, C As Integer)
'セルの背景をパターンから
'塗りつぶしへ変換
'C = ColorIndexを指定
'i = Patternを入れた配列のインデックスを指定

    Dim obj As Object
    Dim ValuePattern As Variant
    ValuePattern = Array(xlPatternAutomatic, xlPatternChecker, _
        xlPatternCrissCross, xlPatternDown, xlPatternGray16, _
        xlPatternGray25, xlPatternGray50, xlPatternGray75, _
        xlPatternGray8, xlPatternGrid, xlPatternHorizontal, _
        xlPatternLightDown, xlPatternLightHorizontal, _
        xlPatternLightUp, xlPatternLightVertical, xlPatternNone, _
        xlPatternSemiGray75, xlPatternSolid, xlPatternUp, _
        xlPatternVertical)
       
    For Each obj In ActiveSheet.UsedRange
        If obj.Interior.Pattern = ValuePattern(i) Then
            obj.Interior.Pattern = xlPatternNone
            obj.Interior.ColorIndex = C
            
        End If
    Next obj
End Sub