【Excelアドイン】便利一覧

#### 1. 赤枠オブジェクトの作成
```
'赤枠作成
Sub CreateSquere()
    Dim R As Range
    Set R = Selection
   
    With ActiveSheet.Shapes.AddShape(msoShapeRectangle, R.Left, R.Top + R.Height, 150, 50)
        .Name = "赤枠"
        .Fill.Visible = msoFalse
        .Line.ForeColor.RGB = RGB(255, 0, 0)
        .Line.Weight = 2.25
    End With

End Sub
```
ショートカット設定
私は以下のショートカットを割り当てています。
```
'ブックを開いたときにショートカットキーを設定する。
Sub Workbook_Open()
    '赤枠作成。ショートカットキー：「ctrl + shift + S」
    Application.OnKey "^+S", "CreateSquere"
End Sub

'ブックを閉じたときにショートカットキー設定を解除する。
Sub Workbook_Close()
    Application.OnKey "^+S"
End Sub
```
#### 2\. 吹出作成
```
'吹出作成
Sub CreateCallout()
    Dim R As Range
    Set R = Selection
   
    With ActiveSheet.Shapes.AddShape(msoShapeRectangularCallout, R.Left, R.Top, 200, 70)
        .Name = "吹き出し"
       
        .Line.ForeColor.RGB = RGB(0, 112, 192)
        .Line.Weight = 2.25
        .TextFrame.Characters.Font.Size = 10
    End With

End Sub

```
```
'ブックを開いた時に追加
Application.OnKey "^+W", "CreateCallout"
'ブックを閉じた時に追加
Application.OnKey "^+W"
```
#### 3\. 黄色セルに塗りつぶし
```
'選択されたセルを黄色に塗潰し
Sub HighlightCell()
    Dim selectedRange As Range
    Set selectedRange = Selection ' 選択されたセルの範囲を取得
   
    Dim cell As Range
    For Each cell In selectedRange ' 選択されたセルのそれぞれに対して処理を行う
        cell.Interior.Color = vbYellow '黄
    Next cell
End Sub
```
```
'ブックを開いた時に追加
Application.OnKey "^+Y", "CreateCallout"
'ブックを閉じた時に追加
Application.OnKey "^+Y"
```
#### 4\. スネークケースに変換
```
'スネークケースに変換する処理
Sub CamelToSnakeExe()
  Dim selectedRange As Range
    Set selectedRange = Selection ' 選択されたセルの範囲を取得
    Dim newNumber As Long
    Dim komoji As String
    Dim i As Integer
    Dim result As Variant
   
    Dim cell As Range
    For Each cell In selectedRange ' 選択されたセルのそれぞれに対して処理を行う
        If Len(cell.Value) > 0 Then ' セルが空ではない場合
            komoji = LCase(cell.Value)
            For i = 1 To Len(komoji)
                If Mid(cell.Value, i, 1) = Mid(komoji, i, 1) Then
                    result = result & Mid(komoji, i, 1)
                ElseIf Mid(cell.Value, i - 1, 1) = Mid(komoji, i - 1, 1) Then
                    result = result & "_" & Mid(komoji, i, 1)
                Else
                    result = result & Mid(komoji, i, 1)
                End If
            Next
        End If
        cell.Value = result
    Next cell

End Sub
```
#### 5\. キャメルケースに変換
```
'キャメルケースに変換する処理
Sub CamelToSnakeExe()
  Dim selectedRange As Range
    Set selectedRange = Selection ' 選択されたセルの範囲を取得
    Dim newNumber As Long
    Dim komoji As String
    Dim i As Integer
    Dim result As Variant
   
    Dim cell As Range
    For Each cell In selectedRange ' 選択されたセルのそれぞれに対して処理を行う
        If Len(cell.Value) > 0 Then ' セルが空ではない場合
            komoji = LCase(cell.Value)
            For i = 1 To Len(komoji)
                If Mid(cell.Value, i, 1) = Mid(komoji, i, 1) Then
                    result = result & Mid(komoji, i, 1)
                ElseIf Mid(cell.Value, i - 1, 1) = Mid(komoji, i - 1, 1) Then
                    result = result & "_" & Mid(komoji, i, 1)
                Else
                    result = result & Mid(komoji, i, 1)
                End If
            Next
        End If
        cell.Value = result
    Next cell

End Sub
```
※4.5.はそこまで頻繁に使用することはないためクイックアクセスツールバーに登録しています。