'グラフのバーをグループ単位で色分け
'大前提：実行前に対象のグラフが選択されていること
Sub Set_Color_Bar()
	
	Dim i As Integer, N As Integer

	'バーの数分だけループ（この例では13個）
	For i = 1 To ActiveChart.SeriesCollection.Count
		N = Val(Right(ActiveChart.SeriesCollection(i).Name, 2))
		'何番目のバーを処理しているか
		If i < 5 Then
			'最初の4本までは青系のバーにする
			Bar_attr i, 33
		ElseIf i < 9 Then
			'最初の5～8本は黄系のバーにする
			Bar_attr i, 6
		Else
			'最初の9本目以降は紫系のバーにする
			Bar_attr i, 7
		End If
	Next
	
	'おまけ
	'ActiveChart.SeriesCollection(i).Name
	'これには「WK01」などの凡例の名称が入る
	
End Sub

'指定バーの色を変更
Sub Bar_attr(bar As Integer, c As Integer)
			'何番目のバーか、色番号
	On Error GoTo pass
	'対象のバーを選択
	ActiveChart.SeriesCollection(bar).Select
	'グラデーションセット
	Selection.Fill.OneColorGradient Style:=msoGradientVertical, Variant:=4, Degree:=0.231372549019608
	Selection.Fill.Visible = True
	'色をセット
	Selection.Fill.ForeColor.SchemeColor = c
pass:
	On Error GoTo 0

End Sub

'全シート内のPIVOTを無条件リフレッシュ
Sub ALL_PIVOT_UPDATE()

	If MsgBox(“全Pivotを一括更新します。" & vbCrLf & _
		“1Pivot xx秒ほどかかります。", vbYesNo) <> vbYes Then Exit Sub
	
	'PIVOTが無いシートはエラーになるため、無視するように設定
	On Error Resume Next
	'全シートを順番に更新
	For i = 1 To ActiveWorkbook.Sheets.Count
		Sheets(i).Activate
		'PIVOTのリフレッシュ
		ActiveWorkbook.Sheets(i).PivotTables(1).PivotCache.Refresh
	Next
	'エラー処理を有効にする
	On Error GoTo 0
	
	MsgBox “done!"

End Sub

'選択物のグラデーション化（相手は必ず黒となる）
Sub 縦下黒()
	On Error Resume Next
	Selection.ShapeRange.Fill.OneColorGradient msoGradientHorizontal, 1, 0.23
	Selection.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=1, Degree:=0.231372549019608
	On Error GoTo 0
End Sub

Sub 縦上黒()
	On Error Resume Next
	Selection.ShapeRange.Fill.OneColorGradient msoGradientHorizontal, 2, 0.23
	Selection.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=2, Degree:=0.231372549019608
	On Error GoTo 0
End Sub

Sub 縦内黒()
	On Error Resume Next
	Selection.ShapeRange.Fill.OneColorGradient msoGradientHorizontal, 3, 0.23
	Selection.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=3, Degree:=0.231372549019608
	On Error GoTo 0
End Sub

Sub 縦外黒()
	On Error Resume Next
	Selection.ShapeRange.Fill.OneColorGradient msoGradientHorizontal, 4, 0.23
	Selection.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=4, Degree:=0.231372549019608
	On Error GoTo 0
End Sub

Sub 横右黒()
	On Error Resume Next
	Selection.ShapeRange.Fill.OneColorGradient msoGradientVertical, 1, 0.23
	Selection.Fill.OneColorGradient Style:=msoGradientVertical, Variant:=1, Degree:=0.231372549019608
	On Error GoTo 0
End Sub

Sub 横左黒()
	On Error Resume Next
	Selection.ShapeRange.Fill.OneColorGradient msoGradientVertical, 2, 0.23
	Selection.Fill.OneColorGradient Style:=msoGradientVertical, Variant:=2, Degree:=0.231372549019608
	On Error GoTo 0
End Sub

Sub 横内黒()
	On Error Resume Next
	Selection.ShapeRange.Fill.OneColorGradient msoGradientVertical, 3, 0.23
	Selection.Fill.OneColorGradient Style:=msoGradientVertical, Variant:=3, Degree:=0.231372549019608
	On Error GoTo 0
End Sub

Sub 横外黒()
	On Error Resume Next
	Selection.ShapeRange.Fill.OneColorGradient msoGradientVertical, 4, 0.23
	Selection.Fill.OneColorGradient Style:=msoGradientVertical, Variant:=4, Degree:=0.231372549019608
	On Error GoTo 0
End Sub

選択したオブジェクトの色をグラデーション化する
起動時にグラデーション用のボタンを作成＆配置

Sub Auto_open()
	Dim cbrWiz As CommandBar
	Dim cbcMenu As CommandBarControl
	Dim ctlInsert As CommandBarButton
	On Error Resume Next
	' コマンド バーが既に存在するかどうかを確認します。
	Set cbrWiz = CommandBars(CBR_INSERT)
	' コマンド バーが存在しない場合は作成します。
	If cbrWiz Is Nothing Then
		Err.Clear
		Set cbrWiz = CommandBars.Add(CBR_INSERT)
		' コマンド バーを表示します。
		cbrWiz.Visible = True
	  
		'グラデーションメニューの追加
		Set cbcMenu = cbrWiz.Controls.Add(Type:=msoControlPopup)
		cbcMenu.Caption = “Gradation"
		Set ctlInsert = cbcMenu.Controls.Add
		With ctlInsert
			.Style = msoButtonCaption
			.Caption = “原色に対して縦下黒のグラデーションセット"
			.Tag = “縦下黒"
			.OnAction = “縦下黒"
		End With
		Set ctlInsert = cbcMenu.Controls.Add
		With ctlInsert
			.Style = msoButtonCaption
			.Caption = “原色に対して縦上黒のグラデーションセット"
			.Tag = “縦上黒"
			.OnAction = “縦上黒"
		End With
		Set ctlInsert = cbcMenu.Controls.Add
		With ctlInsert
			.Style = msoButtonCaption
			.Caption = “原色に対して縦内黒のグラデーションセット"
			.Tag = “縦内黒"
			.OnAction = “縦内黒"
		End With
		Set ctlInsert = cbcMenu.Controls.Add
		With ctlInsert
			.Style = msoButtonCaption
			.Caption = “原色に対して縦外黒のグラデーションセット"
			.Tag = “縦外黒"
			.OnAction = “縦外黒"
		End With
		Set ctlInsert = cbcMenu.Controls.Add
		With ctlInsert
			.Style = msoButtonCaption
			.Caption = “原色に対して横右黒のグラデーションセット"
			.Tag = “横右黒"
			.OnAction = “横右黒"
			.BeginGroup = True
		End With
		Set ctlInsert = cbcMenu.Controls.Add
		With ctlInsert
			.Style = msoButtonCaption
			.Caption = “原色に対して横左黒のグラデーションセット"
			.Tag = “横左黒"
			.OnAction = “横左黒"
		End With
		Set ctlInsert = cbcMenu.Controls.Add
		With ctlInsert
			.Style = msoButtonCaption
			.Caption = “原色に対して横内黒のグラデーションセット"
			.Tag = “横内黒"
			.OnAction = “横内黒"
		End With
		Set ctlInsert = cbcMenu.Controls.Add
		With ctlInsert
			.Style = msoButtonCaption
			.Caption = “原色に対して横外黒のグラデーションセット"
			.Tag = “横外黒"
			.OnAction = “横外黒"
		End With
		
	Else
	  ' 既存のコマンド バーを表示します。
	  cbrWiz.Visible = True
	End If
End Sub

'終了時はボタンを削除する
Sub Auto_close()
	On Error Resume Next
	' 存在するコマンド バーを削除します。
	CommandBars(CBR_INSERT).Delete
End Sub