コンピュータや音楽の事書いてます

ブック内の全角文字を半角に変換する

セルだけでなく、図形などに書かれた文字も。多分できてるはず。カナはやらない。

Option Explicit
'ブック内の全角文字を半角に変換する

Sub main()
    Dim s As Worksheet
    For Each s In ThisWorkbook.Sheets
        exec_sheet s
    Next
End Sub
Sub exec_sheet(s As Worksheet)
    Dim theRange As Range
    
    Set theRange = s.UsedRange
    
    exec_range theRange

    exec_shapes s.Shapes

End Sub
Sub exec_range(theRange As Range)
    Dim c As Range
    For Each c In theRange
        Dim wrk
        wrk = c
        c = toNarrow(c.Value)
        If c <> wrk Then
            Debug.Print c.Parent.Name, c.Column, c.Row
        End If
    Next
    
End Sub

Sub exec_shapes(theShapes As Shapes)
    Dim s As Shape
    On Error Resume Next
    For Each s In theShapes
        Dim wrk As String
        If s.AutoShapeType <> msoShapeMixed Then
            wrk = s.TextFrame.Characters.Text
            s.TextFrame.Characters.Text = toNarrow(wrk)
            If s.TextFrame.Characters.Text <> wrk Then
                Debug.Print s.Parent.Name, s.Left, s.Top, s.Width, s.Height
            End If
        End If
    Next
    
End Sub
'英数字 と +-,./_= を半角に
Function toNarrow(str As String) As String
    Dim b As Integer, i As Integer
    For i = 1 To Len(str)
        b = Asc(Mid(str, i, 1))
        If Asc("a") <= b And Asc("z") >= b Or _
           Asc("A") <= b And Asc("Z") >= b Or _
           Asc("0") <= b And Asc("9") >= b Or _
           InStr("+−,./_=", Chr(b)) Then
            toNarrow = toNarrow + StrConv(Chr(b), vbNarrow)
        Else
            toNarrow = toNarrow + Chr(b)
        End If
    Next
End Function