文字操作 フリガナ変換・付ける・返す

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'*******************************************************************************
'フリガナ変換
'*******************************************************************************
  Me.TextBox7.Value = _
          StrConv(Application.GetPhonetic(Me.TextBox5.Value), vbHiragana)
End Sub

Private Sub フリガナを付ける()
'*******************************************************************************
'フリガナを付ける
'*******************************************************************************
Dim sht As Worksheet, a As Long, b As Long, c As Long, d As String, e As String

'Set sht = ThisWorkbook.Worksheets("Sheet2")
Dim Xname As String
'***********************************
Xname = "給料_外注先.xls"
'***********************************
Set sht = Workbooks(Xname).Worksheets("Sheet1")

With sht
    b = Fnc最終行(sht)
    For a = 1 To b
        If a <> 1 Then
            For c = 2 To 2
                .Cells(a, c + 1).Value = Application.GetPhonetic(.Cells(a, c))
            Next c
        Else
            .Cells(a, 3).Value = "フリガナ"
        End If
    Next a
End With
End Sub

Public Function fncフリガナ(str As String) As String
'*******************************************************************************
'フリガナを返す
'*******************************************************************************
      fncフリガナ = Application.GetPhonetic(str)
End Function

 

 

 

2000年01月01日|[VBサンプルコード]:[文字操作]