選択オブジェクトのグラデーション化①main

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

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