こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

こんな方法を探しています。

普通に文字が日本語で入力されているセルを選択し、マクロを実行するとローマ字表記になる方法はあるのでしょうか。関数ではないとわかったのですが、いい方法はないでしょうか。変換でF9を使う方法をもっと楽にしたいためよろしくお願いします。

投稿日時 - 2014-10-13 21:39:00

QNo.8789637

すぐに回答ほしいです

質問者が選んだベストアンサー

日本語で【入力され】ている【セルを選択】し、マクロを実行すると【ローマ字表記】になる

' ' ------------------------- 標準モジュール専用 -------------------------
' ' /// 選択中のセル範囲の文字列ををローマ字表記に置換する ///
' ' ▼ VBE画面からの実行は不可 ▼

Public Sub Re8789637fun() ' SendKeysマクロ版
Dim c As Range
Dim s As String
Dim sK As String

' ' 〓〓〓 テスト用の仮の記述 〓〓〓 テストが済んだら削除
' ' A列からB列へコピー&ペーストしてB列を選択(B列に対して処理)
Range("A1", Cells(Rows.Count, "A").End(xlUp)).Copy ' テストが済んだら削除
Range("B1").PasteSpecial ' テストが済んだら削除
' ' 〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

' ' Selection がセル範囲でなければ、処理しない
  If TypeName(Selection) <> "Range" Then Exit Sub

' ' 選択範囲での編集中のIMEモードを"ひらがな"にする為、入力規則を設定
  With Selection.Validation
    .Delete
    .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop
    .IMEMode = xlIMEModeHiragana
  End With

' ' 選択範囲内の各セルを総当たり
  For Each c In Selection
    If c.Value <> "" Then ' セルの値が空白でない場合
      If VarType(c.Value) = vbString Then ' セルの値が文字列値の場合
' ' 一旦、セルの値を セルのフリガナに置換する
        s = c.Phonetic.Text ' セルのフリガナ文字列を取得
      ' ' ◆セルにフリガナ情報が無い◆場合の特例処置
        If s Like "*[!ぁ-んァ-ヶ]*" Then ' フリガナ文字列に かな・カナ以外が混じっている場合
          s = Application.GetPhonetic(c.Text) ' IMEの変換履歴を参照してフリガナ候補の筆頭を取得
        End If
        c.Value = s ' セルの値をフリガナに置換
' ' キーストロークをExcelに送って かな・カナを ローマ字に変換
      ' ' Excelに送るキーコードを用意する
        If c.PrefixCharacter = "" Then ' プレフィックスが無い場合
      ' '     {F2}…F2 (+{HOME})…Shift + HOME {93}…アプリケションキー
      ' '      (+v)…Shift + v {F9}…F9 {ENTER}…ENTER
          sK = "{F2}(+{HOME}){93}(+v){F9}{ENTER}"
        Else ' プレフィックスが有る場合は (+{RIGHT})…Shift + → を挿入
          sK = "{F2}(+{HOME})(+{RIGHT}){93}(+v){F9}{ENTER}"
        End If
        c.Activate ' カーソルをセルに移動
      ' ' キーストロークをExcelに送る ひとつひとつのキーコード送信による処理が終るまで待つ
        Application.SendKeys sK, True
      ' ' キーストローク送信による処理が確定するまで僅かな時間Excelを非活性にして待つ * 2回
        DoEvents: DoEvents
        s = c.Value ' ローマ字変換後のセルの値をチェック
        If Len(s) <> LenB(s) Then c.Value = StrConv(s, vbNarrow) ' 全角文字があれば半角にする
      End If
    End If
  Next

' ' 選択範囲に設定しておいた入力規則を削除
  Selection.Validation.Delete

End Sub

' ' ----------------------------------------------------------------------

投稿日時 - 2014-10-14 05:21:31

お礼

ありがとうございます。勉強になりました。

投稿日時 - 2014-10-14 12:03:49

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.1

以下のページはご覧になりましたか?

http://kiyopon.sakura.ne.jp/soft/romaji.htm

投稿日時 - 2014-10-14 00:33:53

お礼

初見でした。ありがとうございます。

投稿日時 - 2014-10-14 12:04:49

あなたにオススメの質問