[[20200630193455]] 『SetPhonetic が使えなくなってしまった』(まめ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『SetPhonetic が使えなくなってしまった』(まめ)

はじめまして、色々検索してみましたが検索の仕方が下手なのか
知りたい情報が見当たらない為お力をお借りしたく存じます。

タイトルの通りなのですが、SetPhoneticが使えなくなってしまいました。

ファイル自体はEXCEL2010にて作成しており、2010と2016では動作が確認できました。
PCが新しくなり、EXCEL2019になったところ使えなくなってしまいました。
また、OFFICE365でも同様に反応しません。

SetPhoneticは古いバージョンでしか使用する事ができないのでしょうか。

< 使用 Excel:Office365、使用 OS:Windows10 >


 >Excel:Office365

 当方では、普通に出来ましたけど?

 >使えなくなってしまいました。
 具体的にどう確認されましたか?

 フリガナを表示させてなかった、なんてオチじゃないですよね?

(半平太) 2020/06/30(火) 20:12


コメントありがとうございます。
振り仮名を表示させるボタンを押しても
1段下がる(本来ふりがなが出る行)だけで何も表示されません。

ファイルが壊れているのかもしれないですね。
明日新規ファイルで試してみます!
(まめ) 2020/06/30(火) 20:59


新規作成のファイルで再度試してみましたがやはり空欄のままでした…
直接入力した文字は当然ですがちゃんとふりがなは表示されます。
他ファイルからコピペした文字が何故か反応しません。

(まめ) 2020/07/01(水) 09:58


外している可能性大です。

私には、以前のバージョンのフリガナの動作記憶はあやふやですが、たしか情報が無い場合でもつけてくれたような気がします。
excel2016(表示365)でも自動取得はされませんね。
ふりがなの編集を押したときと同じで平仮名やローマ字にもフリガナが付いてしまいますが、
(1セルずつなら、上記でフリガナ取得可能)
フリガナを取得したい範囲を選択して、以下を実施すると自動取得されたフリガナを付けたり削除できます。
(要注意) 但し、手入力したセルも変わってしまいます。

 Sub フリガナ追加()
    Dim r As Range, rr
    Set rr = Selection
    If rangeCheck(rr) Then
        For Each r In rr
            r.Characters.PhoneticCharacters = Application.GetPhonetic(r.Value)
        Next
        rr.Phonetics.Visible = True  'フリガナを表示
    End If
 End Sub

 Sub フリガナ削除()
    Dim r As Range, rr
    Set rr = Selection
    If rangeCheck(rr) Then
        For Each r In rr
            r.Phonetics.Alignment = xlPhoneticAlignLeft
            r.Characters.PhoneticCharacters = ""
        Next
        rr.Phonetics.Visible = False  'フリガナを非表示
    End If
 End Sub

 Function rangeCheck(r) As Boolean
    Dim rr As Range
    If TypeName(r) <> "Range" Then Exit Function
    If r.Count = 1 Then
        If r.HasFormula Then Exit Function
        If IsNumeric(r.Value) Then Exit Function
        If IsEmpty(r.Value) Then Exit Function
        rangeCheck = True
    Else
        On Error Resume Next
        Set rr = r.SpecialCells(xlCellTypeConstants, xlValue)
        On Error GoTo 0
        If Not rr Is Nothing Then
            Set r = rr
            rangeCheck = True
        End If
    End If
 End Function

(kazuo) 2020/07/01(水) 21:21


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.