FC2ブログ

週によって色が変わります

2017–07–31 (Mon) 23:42
エクセルマクロで、週によって色が変わる物を作成しました。
条件付き書式です。

Private Sub 日付によって色を変更する()
Dim fc As Long, myRng As Range, strFormula As String
FirstRow = Selection(1).Row
FirstCol = Selection(1).Column
basyo = Cells(FirstRow, FirstCol).Address
basyo = Replace(basyo, "$", "")
strFormula = "=WEEKDAY(" & basyo & ")=7" '土曜なら
With Range(Selection.Address).FormatConditions.Add( _
Type:=xlExpression, Formula1:=strFormula)
.Font.Color = RGB(0, 0, 255)
.StopIfTrue = False
End With
strFormula = "=WEEKDAY(" & basyo & ")=1" '日曜なら
With Range(Selection.Address).FormatConditions.Add( _
Type:=xlExpression, Formula1:=strFormula)
.Font.Color = RGB(255, 0, 0)
.StopIfTrue = False
End With
strFormula = basyo & "=TODAY())"
With Range(Selection.Address).FormatConditions.Add( _
Type:=xlExpression, Formula1:=strFormula)
.Interior.Color = RGB(255, 255, 0)
.StopIfTrue = False
End With

strFormula = "=AND(TODAY()-ROUNDDOWN(" & basyo & ",0)<=WEEKDAY(TODAY())-1,ROUNDDOWN(" & basyo & ",0)-TODAY()<=7-WEEKDAY(TODAY()))"
With Range(Selection.Address).FormatConditions.Add( _
Type:=xlExpression, Formula1:=strFormula)
.Interior.Color = RGB(255, 0, 0)
.StopIfTrue = False
End With
strFormula = "=AND(ROUNDDOWN(" & basyo & ",0)-TODAY()>(7-WEEKDAY(TODAY())),ROUNDDOWN(" & basyo & ",0)-TODAY()<(15-WEEKDAY(TODAY())))"
With Range(Selection.Address).FormatConditions.Add( _
Type:=xlExpression, Formula1:=strFormula)
.Interior.Color = RGB(0, 0, 255)
.StopIfTrue = False
End With
strFormula = "=AND(ROUNDDOWN(" & basyo & ",0)-TODAY()>(14-WEEKDAY(TODAY())),ROUNDDOWN(" & basyo & ",0)-TODAY()<(22-WEEKDAY(TODAY())))"
With Range(Selection.Address).FormatConditions.Add( _
Type:=xlExpression, Formula1:=strFormula)
.Interior.Color = RGB(0, 255, 0)
.StopIfTrue = False
End With
Set myRng = Nothing
End Sub

無題
スポンサーサイト



« 形式保管フォーム | HOME |  アクセス数グラフ作成 »

コメント

コメントの投稿

 
管理者にだけ表示

 | HOME | 

プロフィール

はる

Author:はる
FC2ブログへようこそ!

最新記事

最新コメント

フリーエリア

月別アーカイブ

カテゴリ

ブロとも申請フォーム

検索フォーム

RSSリンクの表示

リンク