【Excel VBA】テキストエディター化パック

文字やセルの装飾ショートカット作成したやつ

## 機能一覧＆ショートカットキー割当表

| ショートカット   | 動作           |
|------------------|----------------|
| Ctrl + E         | 水平位置       |
| Ctrl+Shift+E     | 上下位置       |
| Ctrl+M           | 結合           |
| Ctrl+Shift+M     | 結合解除       |
| Ctrl+Shift+>     | 文字大きく     |
| Ctrl+Shift+<     | 文字小さく     |
| Ctrl+Shift+F     | 文字色トグル切替         |
| Ctrl+Shift+L     | 背景色トグル切替         |
| Ctrl+{TAB}       | インデント下げ |
| Ctrl+Shift+{TAB} | インデント上げ |
| Ctrl+{Enter}       | 行の削除 |
| Ctrl+Shift+{Enter} | 行の追加|

## 標準モジュール

```vb
Option Explicit

Public Enum Color
  Black = 1
  white
  Red
  Green
  Blue
  Yellow
  Pink
  NONE = -4142
End Enum

Sub FontColor()
  Dim Target
  Set Target = Selection.Font
  Call ColorToggle(Target, False)
End Sub

Sub InteriorColor()
  Dim Target
  Set Target = Selection.Interior
  Call ColorToggle(Target, True)
End Sub

Sub ColorToggle(Target, Add_Clear As Boolean)
  With Target
    Select Case Target.ColorIndex
      Case Is = Color.Black
        If Add_Clear = True Then
          .ColorIndex = Color.NONE
        Else
          .ColorIndex = Color.Red
        End If
      Case Is = Color.white: .ColorIndex = Color.Black
      Case Is = Color.Yellow: .ColorIndex = Color.white
      Case Is = Color.Blue: .ColorIndex = Color.Yellow
      Case Is = Color.Red: .ColorIndex = Color.Blue
      Case Else: .ColorIndex = Color.Red
    End Select
  End With
End Sub

Sub HorizontalToggle()
  With Selection
    Select Case .HorizontalAlignment
      Case Is = xlLeft: .HorizontalAlignment = xlRight
      Case Is = xlCenter: .HorizontalAlignment = xlLeft
      Case Else: .HorizontalAlignment = xlCenter
    End Select
  End With
End Sub

Sub VerticalToggle()
  With Selection
    Select Case .VerticalAlignment
      Case Is = xlTop: .VerticalAlignment = xlBottom
      Case Is = xlCenter: .VerticalAlignment = xlTop
      Case Else: .VerticalAlignment = xlCenter
    End Select
  End With
End Sub

Sub Merge_()
  Selection.Merge
End Sub
Sub UnMerge_()
  Selection.UnMerge
End Sub

Sub FontSizeUp()
  Dim r As Range
  For Each r In Selection
    r.Font.Size = r.Font.Size + 1
  Next r
End Sub

Sub FontSizeDown()
  Dim r As Range
  For Each r In Selection
    If r.Font.Size > 1 Then: r.Font.Size = r.Font.Size - 1
  Next r
End Sub

Sub IndentR()
  Call インデント(1)
End Sub

Sub IndentL()
  Call インデント(-1)
End Sub

Sub インデント(上げ下げ As Integer)
  On Error Resume Next
  Selection.InsertIndent 上げ下げ
End Sub

Sub AddRow()
  Dim Rs As Long

  Application.CutCopyMode = False

  Rs = ActiveCell.Row
  Rows(Rs + 1).Insert Shift:=xlDown
End Sub

Sub DeleteRow()
  Dim rc As Integer
  If WorksheetFunction.CountA(ActiveCell.EntireRow) <> 0 Then
      rc = MsgBox("この行にはデータが存在します。この行を削除しますか？", vbYesNo + vbQuestion, "確認")
  Else: rc = vbYes
  End If
  If rc = vbYes Then
      'MsgBox "削除します"
      Rows(Rs).Delete
  End If
End Sub

```
## ThisWorkbookモジュール

```vb
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Application.OnKey "^e"
  Application.OnKey "^+e"
  Application.OnKey "^m"
  Application.OnKey "^+m"
  Application.OnKey "^+>"
  Application.OnKey "^+<"
  Application.OnKey "^+f"
  Application.OnKey "^+l"
  Application.OnKey "^{TAB}"
  Application.OnKey "^+{TAB}"
  Application.OnKey "^~"
  Application.OnKey "^+~"
End Sub
Private Sub Workbook_Open()
  Application.OnKey "^e", "HorizontalToggle"
  Application.OnKey "^+e", "VerticalToggle"
  Application.OnKey "^m", "Merge_"
  Application.OnKey "^+m", "UnMerge_"
  Application.OnKey "^+>", "FontSizeUp"
  Application.OnKey "^+<", "FontSizeDown"
  Application.OnKey "^+f", "FontColor"
  Application.OnKey "^+l", "InteriorColor"
  Application.OnKey "^{TAB}", "IndentR"
  Application.OnKey "^+{TAB}", "IndentL"
  Application.OnKey "^~", "DeleteRow"
  Application.OnKey "^+~", "AddRow"
End Sub
```