Excelのこととか色々

Excel のこととか楽天とか いろいろ書いてみます・・・

【Excel/VBAのこと39】ミニツール シート名、色編集、隣のシートを選択

   f:id:tuna-kichi:20200223230814p:plain

 

**********************************************

シート名の変更や、シートの見出し色を変更するときに、

シートタブをダブルクリックして、名前を変更して、右クリックして色を変更する

という作業を一度でできるミニツールを作ってみました。

 

隣のシートに移動するボタンもつけたので、シート毎に作業しなくてもいいんです。

 

 **********************************************

外観

ツールの外観はこんな感じです。

  ツール外観

・変更するシート名を入力するテキストボックス

・新しいシート名を反映させるコマンドボタン

・見出しの色をワンクリックで変更するコマンドボタン 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

 

**************************************** 

使い方 

まずはリボンに登録して、 

  

  リボンに登録

  

 

クリックしてツールを起動

  

  ツール起動

  

あとは、シート名変更を変更したり、色を変更して完了です。

 

ツールに選別した色であれば簡単に、ワンクリックで変更できるので、

何度も右クリックしてカラーパレットを開く必要がありません。

*************************************************************

おまけ 

したいなかったね

下、居なかったね

死体無かったね

 

うちの子が、「下の階の人は留守だった」という意味で発言したのですが、母親は、「死体!」だと思って何度も聞き返していました・・・

 

言葉って面白いし、難しいですね。

 

*************************************************************

 

個人用マクロブックについてはこちら

www.tuna-kichi.com

 

リボンに登録についてはこちら

www.tuna-kichi.com

 

 

_/_/_/_/_/_/_/_/_/_/_/_/_/_/