【VBA】セルの値をいろいろ変換する

Option Explicit

Private Const CELL_MENU_TAG As String = "fdbcTool_セル操作"

'---------------------------------------------------------------------------------------------------
'【処 理 名】ワークブックオープンイベント
'【処理概要】ワークブックオープン時の処理
'【引    数】なし
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Private Sub Workbook_Open()
    Call addCellMenue
End Sub

'---------------------------------------------------------------------------------------------------
'【処 理 名】セルにメニュー追加
'【処理概要】セルの右クリックメニューを追加する
'【引    数】なし
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Private Sub addCellMenue()
    Dim cmdBar As CommandBar
    Dim cmdBarCtrl As CommandBarControl
    
    Set cmdBar = Application.CommandBars("Cell")
    
    '当ツールで追加したメニューが残っている場合、削除する
    For Each cmdBarCtrl In cmdBar.Controls
        If cmdBarCtrl.Tag = CELL_MENU_TAG Then
            cmdBarCtrl.Delete
        End If
    Next
    
    Set cmdBarCtrl = cmdBar.Controls.Add(Type:=msoControlPopup, Temporary:=True)
    With cmdBarCtrl
        .Caption = "セル操作"
        .Tag = CELL_MENU_TAG

        With .Controls.Add
            .Caption = "小文字⇒大文字"
            .OnAction = "convToUpperCase"
            .FaceId = 2476
        End With
        
        With .Controls.Add
            .Caption = "大文字⇒小文字"
            .OnAction = "convToLowerCase"
            .FaceId = 2476
        End With
        
        With .Controls.Add
            .Caption = "半角⇒全角"
            .OnAction = "convToWide"
            .FaceId = 2476
            .BeginGroup = True
        End With
        
        With .Controls.Add
            .Caption = "全角⇒半角"
            .OnAction = "convToNarrow"
            .FaceId = 2476
        End With
    
        With .Controls.Add
            .Caption = "ひらがな⇒カタカナ"
            .OnAction = "convToKatakana"
            .FaceId = 2476
            .BeginGroup = True
        End With
    
        With .Controls.Add
            .Caption = "カタカナ⇒ひらがな"
            .OnAction = "convToHiragana"
            .FaceId = 2476
        End With
    End With
End Sub

Option Explicit

'---------------------------------------------------------------------------------------------------
'【処 理 名】小文字⇒大文字
'【処理概要】小文字を大文字に変換
'【引    数】なし
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Public Sub convToUpperCase()
    Call StringConvert(vbUpperCase)
End Sub

'---------------------------------------------------------------------------------------------------
'【処 理 名】大文字⇒小文字
'【処理概要】大文字を小文字に変換
'【引    数】なし
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Public Sub convToLowerCase()
    Call StringConvert(vbLowerCase)
End Sub

'---------------------------------------------------------------------------------------------------
'【処 理 名】全角⇒半角
'【処理概要】全角文字を半角文字に変換
'【引    数】なし
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Public Sub convToNarrow()
    Call StringConvert(vbNarrow)
End Sub

'---------------------------------------------------------------------------------------------------
'【処 理 名】ひらがな⇒カタカナ
'【処理概要】ひらがなをカタカナに変換
'【引    数】なし
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Public Sub convToKatakana()
    Call StringConvert(vbKatakana)
End Sub

'---------------------------------------------------------------------------------------------------
'【処 理 名】カタカナ⇒ひらがな
'【処理概要】カタカナをひらがなに変換
'【引    数】なし
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Public Sub convToHiragana()
    Call StringConvert(vbHiragana)
End Sub

'---------------------------------------------------------------------------------------------------
'【処 理 名】半角⇒全角
'【処理概要】半角文字を全角文字に変換
'【引    数】なし
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Public Sub convToWide()
    Call StringConvert(vbWide)
End Sub

'---------------------------------------------------------------------------------------------------
'【処 理 名】初期処理
'【処理概要】初期設定を行う
'【引    数】なし
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Private Sub init()
    '画面の更新をストップする
    Application.ScreenUpdating = False
    '計算方式の設定を「手動」にする
    Application.Calculation = xlCalculationManual
    'ステータスバーに「...処理中」と表示する
    Application.StatusBar = "...処理中"
End Sub

'---------------------------------------------------------------------------------------------------
'【処 理 名】終期処理
'【処理概要】後始末
'【引    数】なし
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Private Sub term()
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.StatusBar = False
End Sub

'---------------------------------------------------------------------------------------------------
'【処 理 名】文字変換
'【処理概要】文字を変換する
'【引    数】[I] ByVal prm As Long
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Private Sub StringConvert(ByVal prm As Long)
    Dim rng As Range
    
    Call init
    '選択されているすべてのセルを変換する
    For Each rng In Selection
        rng.Value = StrConv(rng.Value, prm)
    Next rng
    
    Call term
End Sub