[運用說明]
很多公司的產品會使用顏色管理進行標示，如第一季進貨的產品在標籤上會使用綠色標示，第二季進貨的產品，顏色則回變成紫色以此類推，當然如果有規模的公司作業系統又自動有這個功能，但如果公司內部是使用Excel進行標籤製作，就只能自己標註顏色，有時因為操作人員的不同，選取的顏色也會深淺不一，所以這邊要教大家的是，使用程式碼讓系統判定進貨日期的季度，並將顏色自動變色。
[使用函數]
A.=ROUNDUP(xxx,xxx)
ROUNDUP(目標值，取到小數第幾位)，0是整數位，1為小數第一位以此類推
B.=MONTH(xxx)
MONTH(目標值)
[範例說明]
- 先製作出下表的格式，儲存格B2的公式如下所示
ROUNDUP(MONTH(A2)/3,0)
取A2儲存格的月份除以3，之後無條件進位，會得出所屬季度
如何選取於隨意儲存格內進入 [儲存格格式] 點選 [填滿] [其他色彩]，此時會出現 [色彩視窗] 進入 [自訂] 選取你符合需求的顏色，下面就會出現所對應的 [RGB三原色的代號]，請將其記下，之後撰寫程式時會需要用到。
- 於VBAProject內插入一個模組
模組內的程式碼如下
=========================================================
Sub 第一季()
ActiveSheet.Shapes.Range(Array("圈1")).Select‘圈1的填滿顏色
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(247, 251, 91) ’輸入你剛剛紀錄的第一季RGB的號碼
.Transparency = 0
.Solid
End With
With Selection.ShapeRange.Line‘圈1的線條顏色
.Visible = msoTrue
.ForeColor.RGB = RGB(247, 251, 91) ’輸入你剛剛紀錄的第一季RGB的號碼
.Transparency = 0
End With
Range("a2").Select
End Sub
Sub 第二季()
ActiveSheet.Shapes.Range(Array("圈1")).Select‘圈1的填滿顏色
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 134, 0) ’輸入你剛剛紀錄的第二季RGB的號碼
.Transparency = 0
.Solid
End With
With Selection.ShapeRange.Line‘圈1的線條顏色
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 134, 0) ’輸入你剛剛紀錄的第二季RGB的號碼
.Transparency = 0
End With
Range("a2").Select
End Sub
Sub 第三季()
ActiveSheet.Shapes.Range(Array("圈1")).Select‘圈1的填滿顏色
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(240, 51, 0) ’輸入你剛剛紀錄的第三季RGB的號碼
.Transparency = 0
.Solid
End With
With Selection.ShapeRange.Line‘圈1的線條顏色
.Visible = msoTrue
.ForeColor.RGB = RGB(240, 51, 0) ’輸入你剛剛紀錄的第三季RGB的號碼
.Transparency = 0
End With
Range("a2").Select
End Sub
Sub 第四季()
ActiveSheet.Shapes.Range(Array("圈1")).Select ‘圈1的填滿顏色
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(51, 153, 255) ’輸入你剛剛紀錄的第四季RGB的號碼
.Transparency = 0
.Solid
End With
With Selection.ShapeRange.Line ‘圈1的線條顏色
.Visible = msoTrue
.ForeColor.RGB = RGB(51, 153, 255) ’輸入你剛剛紀錄的第四季RGB的號碼
.Transparency = 0
End With
Range("a2").Select
End Sub
=========================================================
=========================================================
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, [A2:B2]) Is Nothing Then ’如果A2與B2欄位沒有異動則跳出不執行
Exit Sub
Else
If Range("b2").Value = 1 Then ‘如果儲存格 B2 值為1則呼叫 [第一季] 的程式
Call 第一季
Else
If Range("b2").Value = 2 Then ‘如果儲存格 B2 值為2則呼叫 [第二季] 的程式
Call 第二季
Else
If Range("b2").Value = 3 Then ‘如果儲存格 B2 值為3則呼叫 [第三季] 的程式
Call 第三季
Else
If Range("b2").Value = 4 Then ‘如果儲存格 B2 值為4則呼叫 [第四季] 的程式
Call 第四季
End If
End If
End If
End If
End If
End Sub
=========================================================
第一季 第二季
第三季 第四季
留言列表
