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

質問

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

回答No.2

cj_mover · ベストアンサー

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

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

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

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

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

' ' 選択範囲での編集中のＩＭＥモードを"ひらがな"にする為、入力規則を設定
　　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)　'　ＩＭＥの変換履歴を参照してフリガナ候補の筆頭を取得
　　　　　　　　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を非活性にして待つ * ２回
　　　　　　　　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

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

お礼

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

回答No.1

MackyNo1

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

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

お礼

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