**********************************************
シート名の変更や、シートの見出し色を変更するときに、
シートタブをダブルクリックして、名前を変更して、右クリックして色を変更する
という作業を一度でできるミニツールを作ってみました。
隣のシートに移動するボタンもつけたので、シート毎に作業しなくてもいいんです。
**********************************************
外観
ツールの外観はこんな感じです。
・変更するシート名を入力するテキストボックス
・新しいシート名を反映させるコマンドボタン
・見出しの色をワンクリックで変更するコマンドボタン x 7 (色)
・シート移動のコマンドボタン x 2 （左右）
・閉じるボタン
フォームの名前は frmChangeSheetName にしました。
マクロ
'モジュールレベル変数を定義します
Dim SheetName As String
Dim ShCnt As Long
-----------------------------------
閉じるボタン
Private Sub cmdClose_Click()
End
End Sub
-----------------------------------
シート名変更ボタン
Private Sub cmdChange_Click()
'新しいシート名を変数に格納します
SheetName = txtSheetName
ActiveSheet.Name = SheetName
End Sub
-----------------------------------
右に移動ボタン
Private Sub cmdAfter_Click()
Dim n As Long
'アクティブシートが左から何番目のシートか計算します
n = ActiveSheet.Index
If n + 1 > ShCnt Then
'n がシート総数より大きければ、何もしない
Else
'現在のシートより、+1 すれば右隣のシートを選択できます
n = n + 1
Sheets(n).Select
Call UserForm_Initialize
End If
End Sub
-----------------------------------
左に移動ボタン
Private Sub cmdBefore_Click()
Dim n As Long
n = ActiveSheet.Index
If n - 1 < 1 Then
Else
'現在のシートより、-1 すれば右隣のシートを選択できます
n = n - 1
Sheets(n).Select
Call UserForm_Initialize
End If
End Sub
-----------------------------------
シートの見出しの色
赤色
Private Sub cmdRed_Click()
SheetName = ActiveSheet.Name
ActiveWorkbook.Sheets(SheetName).Tab.ColorIndex = 3
End Sub
-----------------------------------
青色
Private Sub cmdBlue_Click()
SheetName = ActiveSheet.Name
ActiveWorkbook.Sheets(SheetName).Tab.ColorIndex = 5
End Sub
-----------------------------------
黄色
Private Sub cmdYellow_Click()
SheetName = ActiveSheet.Name
ActiveWorkbook.Sheets(SheetName).Tab.ColorIndex = 6
End Sub
-----------------------------------
緑色
Private Sub cmdGreen_Click()
SheetName = ActiveSheet.Name
ActiveWorkbook.Sheets(SheetName).Tab.ColorIndex = 10
End Sub
-----------------------------------
白色（色なし）
Private Sub cmdNoColor_Click()
SheetName = ActiveSheet.Name
ActiveWorkbook.Sheets(SheetName).Tab.ColorIndex = xlNone
End Sub
-----------------------------------
黒色
Private Sub cmdBlack_Click()
SheetName = ActiveSheet.Name
ActiveWorkbook.Sheets(SheetName).Tab.ColorIndex = 1
End Sub
-----------------------------------
灰色
Private Sub cmdGray_Click()
SheetName = ActiveSheet.Name
ActiveWorkbook.Sheets(SheetName).Tab.ColorIndex = 16
End Sub
-----------------------------------
ツール初期化
Private Sub UserForm_Initialize()
'アクティブシート名を入力します
txtSheetName.Text = ActiveSheet.Name
ShCnt = Sheets.Count 'シート数を数えます
'テキストボックスに入力されたシート名を選択状態にします
With txtSheetName
.SetFocus
.SelStart = 0
.SelLength = Len(txtSheetName)
End With
End Sub
-----------------------------------
標準モジュール
'ツールを起動させるマクロです
'このマクロは標準モジュールに記載します
'vbModeless を記載しておけばツールを起動させたまま Excel を操作できます
'このマクロをリボンに登録してください
Sub シート名編集()
frmChangeSheetName.Show vbModeless
End Sub
****************************************
使い方
まずはリボンに登録して、
クリックしてツールを起動
あとは、シート名変更を変更したり、色を変更して完了です。
ツールに選別した色であれば簡単に、ワンクリックで変更できるので、
何度も右クリックしてカラーパレットを開く必要がありません。
*************************************************************
おまけ
したいなかったね
下、居なかったね
死体無かったね
うちの子が、「下の階の人は留守だった」という意味で発言したのですが、母親は、「死体！」だと思って何度も聞き返していました・・・
言葉って面白いし、難しいですね。
*************************************************************
個人用マクロブックについてはこちら
リボンに登録についてはこちら
＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／＿／
