HOME > エクセルVBA > サンプル > Convert

Convert


【ファイル名】Convert.xlam
【バージョン】Ver 1.0.5.2
【作成日】2015年01月08日
【更新日】2019年03月17日
【動作確認】Windows 10
【必要なソフト】Microsoft Excel 2010 (アドインとして作成)
【ダウンロード】Convert.zip
【説明】リボンに[サンプル]タブ追加し、選択したセルの文字列を変換するアドインのサンプルです。

セルの編集中では実行できません。
セルが数値でかつ表示形式が標準や数値の場合は全角になりません。Excelが自動変換します。
「半角数字のみ全角数字」ボタンの処理でセルの表示形式を文字列に変更してます。
StrConv関数は日本語(半角、全角、ひらがな、カタカナ)を正しく変換できない場合があります。(変換できない場合は?になるなど)

リボンの[サンプル]タブ

customUI14.xml(Excel 2007にはないimageMsoがあります)
<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
  <ribbon startFromScratch="false">
    <tabs>
      <tab id="Tab1" label="サンプル">
        <group id="Group1" label="変換">
          <button id="LowerCaseButton" label="すべて小文字にする" imageMso="TextRotate90Degrees" supertip="すべての英字を小文字にします。" size="normal" onAction="Convert.xlam!cvOnAction" />
          <button id="UpperCaseButton" label="すべて大文字にする" imageMso="TextAllCaps" supertip="すべての英字を大文字にします。" size="normal" onAction="Convert.xlam!cvOnAction" />
          <button id="TitleWordButton" label="各英単語の先頭文字のみ大文字にする" imageMso="TextNormalCase" supertip="各英単語の先頭文字のみを大文字に、先頭以外は小文字にします。" size="normal" onAction="Convert.xlam!cvOnAction" />
          <separator id="Separator1" />
          <button id="LCaseHButton" label="半角英字のみ小文字" imageMso="InkToTextMode" supertip="半角英字のみ小文字に変換します。" size="normal" onAction="Convert.xlam!cvOnAction" />
          <button id="UCaseHButton" label="半角英字のみ大文字" imageMso="ActiveXLabel" supertip="半角英字のみ大文字に変換します。" size="normal" onAction="Convert.xlam!cvOnAction" />
          <separator id="Separator2" />
          <button id="HalfWidthButton" label="半角" imageMso="H" supertip="全角を半角にします。" size="large" onAction="Convert.xlam!cvOnAction" />
          <button id="FullWidthButton" label="全角" imageMso="Z" supertip="半角を全角にします。&#13;【注意】変換できない文字は「?」になります。&#13;【注意】数値でかつ表示形式が数値の場合は全角になりません。" size="large" onAction="Convert.xlam!cvOnAction" />
          <separator id="Separator3" />
          <button id="ToHanNumButton" label="全角数字のみ半角数字" imageMso="CalculatedNumber" supertip="全角数字のみ、半角数字に変換します。&#13;【注意】数字ではなく、単独の(−,.)も半角にします。" size="normal" onAction="Convert.xlam!cvOnAction" />
          <button id="ToZenNumButton" label="半角数字のみ全角数字" imageMso="CalculatedNumber" supertip="半角数字のみ、全角数字に変換します。&#13;表示形式を文字列に変更します。&#13;【注意】数字ではなく、単独の(-,.)も全角にします。" size="normal" onAction="Convert.xlam!cvOnAction" />
          <button id="ToZenKanaButton" label="半角カタカナのみ全角カタカナ" imageMso="K" supertip="半角カタカナのみ、全角カタカナに変換します。&#13;【注意】変換できない文字は「?」になります。&#13;【注意】この例は半角カタカナをUnicodeのFF61-FF9Fの範囲とします。(「。」から「゚」)普通は「ヲ」から「ン」です。" size="normal" onAction="Convert.xlam!cvOnAction" />
          <separator id="Separator4" />
          <button id="KatakanaButton" label="カタカナ" imageMso="K" supertip="ひらがなをカタカナにします。" size="large" onAction="Convert.xlam!cvOnAction" />
          <button id="HiraganaButton" label="ひらがな" imageMso="H" supertip="全角カタカナのみをひらがなにします。" size="large" onAction="Convert.xlam!cvOnAction" />
          <separator id="Separator5" />
          <button id="LTrimButton" label="先頭のスペースを削除" imageMso="Delete" supertip="先頭のスペースを削除します。" size="normal" onAction="Convert.xlam!cvOnAction" />
          <button id="TrimButton" label="先頭と末尾のスペースを削除" imageMso="Delete" supertip="先頭と末尾のスペースを削除します。" size="normal" onAction="Convert.xlam!cvOnAction" />
          <button id="RTrimButton" label="末尾のスペースを削除" imageMso="Delete" supertip="末尾のスペースを削除します。" size="normal" onAction="Convert.xlam!cvOnAction" />
          <button id="DelSpaceButton" label="すべてのスペースを削除" imageMso="Delete" supertip="すべてのスペースを削除します。" size="large" onAction="Convert.xlam!cvOnAction" />
          <separator id="Separator6" />
          <button id="AboutBoxButton" label="バージョン情報" imageMso="Info" supertip="バージョン情報を表示します。" size="large" onAction="Convert.xlam!cvOnAboutBoxButton" />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>
supertipの「&#13;」は改行です。

このページの上

VBEMainModule
Option Explicit       ' 変数は明示的に宣言しなければいけない
Option Private Module ' プロジェクトの外部からモジュールの内容が参照できない
Option Compare Binary ' 文字列比較はバイナリ文字コード
Option Base 0         ' 配列の添字の既定値を 0 に設定

Private Const csVersion As String = "Version 1.0.5.2" ' バージョン

Sub cvOnAction(control As IRibbonControl)
  Dim Cnt As Variant ' カウンタ
  Dim tmpCalculation As XlCalculation ' 計算方法のモード
  Dim IsDisplayStatusBar As Boolean ' ステータスバーの表示状態を保存
  Dim IsDisplayPageBreaks As Boolean ' 改ページを無効にします
  Dim Ret As VbMsgBoxResult ' MsgBoxの返値
  Dim Rng As Range ' 選択したセル範囲の1つのセル

  If Application.ActiveCell Is Nothing Then Exit Sub ' ブックを開いていてワークシートを選択していない場合は終了。
  'If StrComp(TypeName(Selection), "Range") <> 0 Then Exit Sub ' セルを選択していなければ終了。
  If ActiveWindow.RangeSelection.AllowEdit = False Then
    MsgBox Prompt:="選択したセルが編集できません!", Buttons:=vbCritical, Title:="エラー" ' ◆ シートが保護でロックのセルを含む場合
    Exit Sub
  End If

  Cnt = 0
  Err.Clear ' エラーをクリアーします。
  On Error GoTo ErrorHandle ' ◆ エラー処理ルーチンを有効にします。
  Application.EnableEvents = False ' イベントを無効にします。
  tmpCalculation = Application.Calculation ' 計算方法のモードを保存
  Application.Calculation = xlCalculationManual ' 計算方法のモードを手動にし、計算しない
  Application.EnableCancelKey = xlErrorHandler ' ◆ Esc キーを押すとエラーにします。
  IsDisplayStatusBar = Application.DisplayStatusBar ' ステータスバーの表示状態を保存
  Application.StatusBar = "実行中です。しばらくお待ちください..." ' ステータスバーにメッセージを表示
  Application.DisplayStatusBar = True ' ステータスバーを表示
  Application.Cursor = xlWait ' マウスカーソルを砂時計
  If Not ActiveCell Is Nothing Then
    IsDisplayPageBreaks = ActiveSheet.DisplayPageBreaks ' 改ページの有効・無効を保存します。
    ActiveSheet.DisplayPageBreaks = False ' 改ページを無効にします。
  End If
  Application.ScreenUpdating = False '画面の更新を停止して、ちらつきを防止(ステータスバーのメッセージは更新できます)

  'For Each Rng In Selection ' セルを選択している事!(「Selection」の場合は図形、画像、グラフなどオブジェクトを選択してはいけない)
  For Each Rng In ActiveWindow.RangeSelection ' ◆ セル以外を選択しても実行する TypeName(Selection) = "Range"でなくて良い!
    Select Case control.ID
      Case "LowerCaseButton"
        Rng.Value = StrConv(Rng.Value, vbLowerCase)
      Case "UpperCaseButton"
        Rng.Value = StrConv(Rng.Value, vbUpperCase)
      Case "TitleWordButton"
        Rng.Value = StrConv(Rng.Value, vbProperCase)
      Case "HalfWidthButton"
        Rng.Value = StrConv(Rng.Value, vbNarrow)
      Case "FullWidthButton"
        Rng.Value = Han2Zen(Rng.Value)
      Case "KatakanaButton"
        Rng.Value = StrConv(Rng.Value, vbKatakana)
      Case "HiraganaButton"
        Rng.Value = StrConv(Rng.Value, vbHiragana)
      Case "ToZenKanaButton"
        Rng.Value = Application.Run("'" & ThisWorkbook.Name & "'!HanKana2Zen", Rng.Value)
      Case "LCaseHButton"
        Rng.Value = Application.Run("'" & ThisWorkbook.Name & "'!LCaseH", Rng.Value)
      Case "UCaseHButton"
        Rng.Value = Application.Run("'" & ThisWorkbook.Name & "'!UCaseH", Rng.Value)
      Case "ToHanNumButton" ' 【注意】数字ではなく、単独の(−,.)も半角にします。
        Rng.Value = Application.Run("'" & ThisWorkbook.Name & "'!Hankaku", Rng.Value)
      Case "ToZenNumButton" ' 【注意】数字ではなく、単独の(-,.)も全角にします。
        Rng.NumberFormatLocal = "@" ' ◆ 数字のみの値は表示形式を文字列に変更しないと半角に戻ってしまいます!
        Rng.Value = Application.Run("'" & ThisWorkbook.Name & "'!Zenkaku", Rng.Value, "0123456789,.-")
      Case "LTrimButton"
        Rng.Value = LTrim$(Rng.Value)
      Case "TrimButton"
        Rng.Value = Trim$(Rng.Value)
      Case "RTrimButton"
        Rng.Value = RTrim$(Rng.Value)
      Case "DelSpaceButton"
        Rng.Replace What:=" ", Replacement:="", LookAt:=xlPart, MatchByte:=False
      Case Else
        Beep ' 警告音を鳴らす
        MsgBox "指定したコマンドがありません!", vbCritical
        GoTo ErrorHandle
    End Select

    Cnt = Cnt + 1
    If Cnt > 500 Then ' 500の値は環境により異なります。
      Cnt = 0
      DoEvents ' オペレーティング システムによって処理できるようにする。
    End If
  Next Rng

ErrorHandle: ' ◆ 元に戻す処理 (エラーや、[ESC]キーが押された場合のため)
  If Err.Number > 0 Then ' エラー処理
    Ret = MsgBox(Prompt:=Err.Description & vbCrLf & vbCrLf & "処理を続けますか?", Buttons:=vbExclamation + vbAbortRetryIgnore, Title:="エラー")
    Err.Clear ' エラーをクリアーします。
    If Ret = vbRetry Then Resume ' 再試行
    If Ret = vbIgnore Then Resume Next ' 無視
    ' 中止の場合は下の行の処理へ
  End If
' 元の設定に戻します。
  Application.EnableEvents = True ' イベントを有効にします。
  If Not Application.ActiveCell Is Nothing Then
    Application.Calculation = tmpCalculation ' 計算方法のモードを元に戻す
  End If
  Application.StatusBar = "" ' ステータスバーをを元に戻す
  Application.DisplayStatusBar = IsDisplayStatusBar ' ステータスバーの表示を元に戻す
  Application.Cursor = xlDefault ' マウスカーソルを省略値に戻す
  If Not ActiveCell Is Nothing Then ActiveSheet.DisplayPageBreaks = IsDisplayPageBreaks ' 改ページを元に戻します。
  Application.EnableCancelKey = xlInterrupt ' デバッグ、終了などを行えるように、実行中のプロシージャを停止
  Application.ScreenUpdating = True '画面の更新をする
End Sub

' バージョン情報
Sub cvOnAboutBoxButton(control As IRibbonControl)
  Dim Msg As String

  Msg = ThisWorkbook.Name & vbCrLf & vbCrLf & csVersion
  MsgBox Prompt:=Msg, Buttons:=vbInformation, Title:="バージョン情報"
End Sub

このページの上

VBECommonModule
Option Explicit       ' 変数は明示的に宣言しなければいけない
Option Private Module ' プロジェクトの外部からモジュールの内容が参照できない
Option Compare Binary ' 文字列比較はバイナリ文字コード
Option Base 0         ' 配列の添字の既定値を 0 に設定

' 半角を全角にします。
Public Function Han2Zen(Han As String) As String
' この関数よりもエクセルのJIS関数(Application.WorksheetFunction.Dbcs)を使用した方が良いでしょう。
' この関数は「ア゙」などの変換できない半角の濁音(゙)や半濁音(゚)は全角の濁音(゛)や半濁音(゜)にします。(結合文字にはしません)
  Dim i As Long, l As Long
  Dim C As String, s As String, h As String

  l = Len(Han)
  s = ""
  Han2Zen = ""
  For i = 1 To l
    C = Mid$(Han, i, 1) ' 1文字づつ取得します。
    If C Like "[。-゚]" Then ' 半角カタカナの場合は
      s = s & C ' 濁音や半濁音があるため、まとめてから全角に変換する必要があります。
      If C = "゙" Or C = "゚" Then ' 濁音(゙)や半濁音(゚)
        Han2Zen = Han2Zen & StrConv(s, vbWide)
        h = Right$(Han2Zen, 1) ' 最後の文字
        If h = "?" Then ' 変換できない場合は
          Han2Zen = Left$(Han2Zen, Len(Han2Zen) - 1) ' 最後の文字を削除
          If C = "゙" Then  ' 濁点
            Han2Zen = Han2Zen & "゛" ' 全角の濁点を追加します
          End If
          If C = "゚" Then ' 半濁点
            Han2Zen = Han2Zen & "゜" ' 全角の半濁点を追加します
          End If
        End If
        s = ""
      End If
    Else
      Han2Zen = Han2Zen & StrConv(s & C, vbWide)
      s = ""
    End If
  Next i

  If s <> "" Then ' まだ半角カタカナを変換していない場合は
    Han2Zen = Han2Zen & StrConv(s, vbWide)
  End If
End Function

' 指定した半角の文字のみ、全角に変換する
' 引数のHankakuを省略した場合は記号(。「」、・)を除いた半角カタカナを全角に変換します。
Public Function Zenkaku(ByVal expression As String, _
                        Optional ByVal Hankaku As String = "ヲァィゥェォャュョッーアイウエオカキクケコサシスセソタチツテトナニヌネノハヒフヘホマミムメモヤユヨラリルレロワンガギグゲゴザジズゼゾダヂヅデドパピプペポ") As String
  Dim i As Long, l As Long
  Dim C As String, str As String, h As String

  Zenkaku = vbNullString
  l = Len(expression)
  If l < 1 Then Exit Function
  str = vbNullString
  For i = 1 To l
    C = Mid$(expression, i, 1)
    If InStr(1, Hankaku, C, VBA.vbBinaryCompare) > 0 Then ' 全角に変換する文字がある場合は
      str = str & C ' 濁音(゙)や半濁音(゚)があるので、連続する半角カタカナを取得してから全角に変換します。
      If C = "゙" Or C = "゚" Then ' 濁音(゙)や半濁音(゚)
        Zenkaku = Zenkaku & StrConv(str, vbWide)
        h = Right$(Zenkaku, 1) ' 最後の文字
        If h = "?" Then ' 変換できない場合は
          Zenkaku = Left$(Zenkaku, Len(Zenkaku) - 1) ' 最後の文字を削除
          If C = "゙" Then  ' 濁点
            Zenkaku = Zenkaku & "゛" ' 全角の濁点を追加します
          End If
          If C = "゚" Then ' 半濁点
            Zenkaku = Zenkaku & "゜" ' 全角の半濁点を追加します
          End If
        End If
        str = vbNullString
      End If
    Else
      Zenkaku = Zenkaku & StrConv(str, vbWide) & C
      str = vbNullString
    End If
  Next i
  If Len(str) > 0 Then Zenkaku = Zenkaku & StrConv(str, vbWide) ' まだ変換していない場合は
End Function

' 指定した全角の文字のみ、半角に変換する
Public Function Hankaku(ByVal expression As String, _
                        Optional ByVal Zenkaku As String = "0123456789,.−") As String
  Dim i As Long, l As Long
  Dim C As String

  Hankaku = vbNullString
  l = Len(expression)
  If l < 1 Then Exit Function
  For i = 1 To l
    C = Mid$(expression, i, 1)
    If InStr(1, Zenkaku, C, VBA.vbBinaryCompare) Then
      Hankaku = Hankaku & StrConv(C, vbNarrow)
    Else
      Hankaku = Hankaku & C
    End If
  Next i
End Function

' 半角のカタカナのみを全角にします。
Public Function HanKana2Zen(Han As String) As String
' 「ア゚」などの変換できない半角の濁音(゙)や半濁音(゚)は全角の濁音(゛)や半濁音(゜)にします。(結合文字にはしません)
' この関数は半角カタカナに記号を含めたUnicodeのFF61-FF9Fの範囲とします。(。)から(゚)まで 【注意】サンプルによっては「ヲ」から「ン」としてます。
' 。「」、・ヲァィゥェォャュョッーアイウエオカキクケコサシスセソタチツテトナニヌネノハヒフヘホマミムメモヤユヨラリルレロワン゙゚
' この関数では半角カタカナにカナ記号(。「」、・)を含め、半角の空白は含めません。
' 全角カタカナ 。「」、・ヲァィゥェォャュョッーアイウエオカキクケコサシスセソタチツテトナニヌネノハヒフヘホマミムメモヤユヨラリルレロワンガギグゲゴザジズゼゾダヂヅデドパピプペポ
  Dim i As Long, l As Long
  Dim C As String, s As String, h As String

  l = Len(Han)
  s = ""
  HanKana2Zen = ""
  For i = 1 To l
    C = Mid$(Han, i, 1) ' 1文字づつ取得します。
    If C Like "[。-゚]" Then ' 半角カタカナの場合は
      s = s & C ' 濁音や半濁音があるため、まとめてから全角に変換する必要があります。
      If C = "゙" Or C = "゚" Then ' 濁音(゙)や半濁音(゚)
        HanKana2Zen = HanKana2Zen & StrConv(s, vbWide)
        h = Right$(HanKana2Zen, 1) ' 最後の文字
        If h = "?" Then ' 変換できない場合は
          HanKana2Zen = Left$(HanKana2Zen, Len(HanKana2Zen) - 1) ' 最後の文字を削除
          If C = "゙" Then  ' 濁点
            HanKana2Zen = HanKana2Zen & "゛" ' 全角の濁点を追加します
          End If
          If C = "゚" Then ' 半濁点
            HanKana2Zen = HanKana2Zen & "゜" ' 全角の半濁点を追加します
          End If
        End If
        s = ""
      End If
    Else
      HanKana2Zen = HanKana2Zen & StrConv(s, vbWide) & C
      s = ""
    End If
  Next i

  If s <> "" Then ' まだ半角カタカナを変換していない場合は
    HanKana2Zen = HanKana2Zen & StrConv(s, vbWide)
  End If
End Function

' 半角の英字のみ小文字に変換します。
Public Function LCaseH(ByVal str As String) As String
  Dim i As Long, l As Long
  Dim C As String

  LCaseH = vbNullString
  l = Len(str)
  If l < 1 Then Exit Function
  For i = 1 To l
    C = Mid$(str, i, 1)
    If Asc(C) >= Asc("A") And Asc(C) <= Asc("Z") Then
      C = LCase$(C)
    End If
    LCaseH = LCaseH & C
  Next i
End Function

' 半角の英字のみ大文字に変換します。
Public Function UCaseH(ByVal str As String) As String
  Dim i As Long, l As Long
  Dim C As String

  UCaseH = vbNullString
  l = Len(str)
  If l < 1 Then Exit Function
  For i = 1 To l
    C = Mid$(str, i, 1)
    If Asc(C) >= Asc("a") And Asc(C) <= Asc("z") Then
      C = UCase$(C)
    End If
    UCaseH = UCaseH & C
  Next i
End Function

このページの上