グラデーションなしでVBAを使用して複数の背景色を持つセルをExcelで作成するにはどうすればよいですか？

Question

だからここに問題があります。 Microsoft Excelを使用してセル内に複数の背景色を設定する方法。マイクロソフトでは、セルメニュー>塗りつぶし>塗りつぶしの書式のグラデーション機能を使用していますが、グラデーションを使用しています。私は無地の色が欲しい。

私は自分自身の質問に答えるつもりであることを警告しますが、私はこの解決策をまだどこに求めているのか分かりません。

Answer 1

ここで私がFill Effectsのために記録したコードを変更して見つけた解決策を示します。

要するに、グラデーションを削除するためのキーは、カラーストップスの色をお互いに非常に近いものにすることです。

下記の私の例を参照してください。私は二次回答にもっと例を掲示します。

Sub Macro5() 
' 
' Macro5 Macro 
' 

'Linear Gradients 
' value  description       Example 
' 0 Degree Vertical       1 

'Example 1 
With Selection.Interior 
    .Pattern = xlPatternLinearGradient 
    .Gradient.Degree = 0 
    .Gradient.ColorStops.Clear 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0) 
    .ThemeColor = xlThemeColorDark1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.49) 
    .ThemeColor = xlThemeColorDark1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.51) 
    .ThemeColor = xlThemeColorAccent1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(1) 
    .ThemeColor = xlThemeColorAccent1 
End With 


End Sub 

Answer 2

ここで約束されているのは、異なる細胞充てん方法の例である。

Sub Macro6() 
' 
' Macro5 Macro 
' 

'Linear Gradients 
' value  description       Example 
' 90 Degree Horizontal       2 
' 45 Degree Diagonal (UL,LwR Corners)   3 
' 135 Degree Diagonal (LwL UR Corners)   4 
' ??? Degree Whatever ofther angle you want!  5 
' U = Upper, Lw = Lower, L = Left, R = Right 



'Example 2 
ActiveCell.Offset(1, 0).Range("A1").Select 
With Selection.Interior 
    .Pattern = xlPatternLinearGradient 
    .Gradient.Degree = 90 
    .Gradient.ColorStops.Clear 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0) 
    .ThemeColor = xlThemeColorDark1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.49) 
    .ThemeColor = xlThemeColorDark1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.51) 
    .ThemeColor = xlThemeColorAccent1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(1) 
    .ThemeColor = xlThemeColorAccent1 
End With 

'Example 3 
ActiveCell.Offset(1, 0).Range("A1").Select 
With Selection.Interior 
    .Pattern = xlPatternLinearGradient 
    .Gradient.Degree = 45 
    .Gradient.ColorStops.Clear 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0) 
    .ThemeColor = xlThemeColorDark1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.49) 
    .ThemeColor = xlThemeColorDark1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.51) 
    .ThemeColor = xlThemeColorAccent1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(1) 
    .ThemeColor = xlThemeColorAccent1 
End With 

'Example 4 
ActiveCell.Offset(1, 0).Range("A1").Select 
With Selection.Interior 
    .Pattern = xlPatternLinearGradient 
    .Gradient.Degree = 135 
    .Gradient.ColorStops.Clear 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0) 
    .ThemeColor = xlThemeColorDark1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.49) 
    .ThemeColor = xlThemeColorDark1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.51) 
    .ThemeColor = xlThemeColorAccent1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(1) 
    .ThemeColor = xlThemeColorAccent1 
End With 

'Example 5 
ActiveCell.Offset(1, 0).Range("A1").Select 
With Selection.Interior 
    .Pattern = xlPatternLinearGradient 
    .Gradient.Degree = 15 
    .Gradient.ColorStops.Clear 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0) 
    .ThemeColor = xlThemeColorDark1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.49) 
    .ThemeColor = xlThemeColorDark1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.51) 
    .ThemeColor = xlThemeColorAccent1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(1) 
    .ThemeColor = xlThemeColorAccent1 
End With 

'Rectangular Gradients 
'See Example 6 
'Selecting Quadrant 
' Property  Value  Example Result 
' RectangleLeft 0 or 1  1  Upper Right Quadrant 
' RectangleTop 0 or 1  0 
' RectangleRight 0 or 1  1 
' RectangleBottom 0 or 1  0 

'Selecting Center 
'See Example 7 
'Value other than .5 get you off center but still off of edge 
' Property  Value  Example Result 
' RectangleLeft 0.5   1  Center 
' RectangleTop 0.5   0 
' RectangleRight 0.5   1 
' RectangleBottom 0.5   0 

'Change Size of Quadrant or Center 
'see example 8,9 
' Use color stops to do this 
' remember to keep colr stops closs to remove gradient 
' Example color stops at 0, 0.49, 0.51, 1 will give you either 
' a quadrant or approximately half of center 

'Example 6 

ActiveCell.Offset(1, 0).Range("A1").Select 
With Selection.Interior 
    .Pattern = xlPatternRectangularGradient 
    .Gradient.RectangleLeft = 1 
    .Gradient.RectangleTop = 1 
    .Gradient.RectangleRight = 1 
    .Gradient.RectangleBottom = 1 
    .Gradient.ColorStops.Clear 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0) 
    .ThemeColor = xlThemeColorDark1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.49) 
    .ThemeColor = xlThemeColorDark1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.51) 
    .ThemeColor = xlThemeColorAccent1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(1) 
    .ThemeColor = xlThemeColorAccent1 
End With 

'Example 7 
ActiveCell.Offset(1, 0).Range("A1").Select 
With Selection.Interior 
    .Pattern = xlPatternRectangularGradient 
    .Gradient.RectangleLeft = 0.5 
    .Gradient.RectangleRight = 0.5 
    .Gradient.RectangleTop = 0.5 
    .Gradient.RectangleBottom = 0.5 
    .Gradient.ColorStops.Clear 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0) 
    .ThemeColor = xlThemeColorDark1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.49) 
    .ThemeColor = xlThemeColorDark1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.51) 
    .ThemeColor = xlThemeColorAccent1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(1) 
    .ThemeColor = xlThemeColorAccent1 
End With 

'Example 8 
    ActiveCell.Offset(1, 0).Range("A1").Select 
With Selection.Interior 
    .Pattern = xlPatternRectangularGradient 
    .Gradient.RectangleLeft = 1 
    .Gradient.RectangleTop = 1 
    .Gradient.RectangleRight = 1 
    .Gradient.RectangleBottom = 1 
    .Gradient.ColorStops.Clear 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0) 
    .ThemeColor = xlThemeColorDark1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.69) 
    .ThemeColor = xlThemeColorDark1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.71) 
    .ThemeColor = xlThemeColorAccent1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(1) 
    .ThemeColor = xlThemeColorAccent1 
End With 

'Example 9 
ActiveCell.Offset(1, 0).Range("A1").Select 
With Selection.Interior 
    .Pattern = xlPatternRectangularGradient 
    .Gradient.RectangleLeft = 0.5 
    .Gradient.RectangleRight = 0.5 
    .Gradient.RectangleTop = 0.5 
    .Gradient.RectangleBottom = 0.5 
    .Gradient.ColorStops.Clear 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0) 
    .ThemeColor = xlThemeColorDark1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.29) 
    .ThemeColor = xlThemeColorDark1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.31) 
    .ThemeColor = xlThemeColorAccent1 
End With 

With Selection.Interior.Gradient.ColorStops.Add(1) 
    .ThemeColor = xlThemeColorAccent1 
End With 



'Example 10 (German Flag) 
ActiveCell.Offset(1, 0).Range("A1").Select 
With Selection.Interior 
    .Pattern = xlPatternLinearGradient 
    .Gradient.Degree = 90 
    .Gradient.ColorStops.Clear 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0) 
    .Color = RGB(0, 0, 0) 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.329) 
    .Color = RGB(0, 0, 0) 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.331) 
    .Color = RGB(208, 0, 0) 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.659) 
    .Color = RGB(208, 0, 0) 
End With 

With Selection.Interior.Gradient.ColorStops.Add(0.661) 
    .Color = RGB(255, 206, 0) 
End With 

With Selection.Interior.Gradient.ColorStops.Add(1) 
    .Color = RGB(255, 206, 0) 
End With 

End Sub