1. 首頁
  2. 問答
  3. 如何使用無漸變的VBA在Excel中製作具有多種背景顏色的單元格？

如何使用無漸變的VBA在Excel中製作具有多種背景顏色的單元格？

2017-06-12 81 views

回答

1

這是我通過改變我爲填充效果記錄的代碼找到的解決方案。

總之，去除漸變的關鍵是讓colorstops的顏色變得非常接近彼此。

看到我下面的例子。我將在二級答案中發佈更多示例。

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

來源

2017-06-12 17:38:19 Gibbs314

0

這裏承諾的是一些不同的單元格填充方法的例子。

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

來源

2017-06-12 17:43:18 Gibbs314

相關問題

 相關問題