Excel VBA（マクロ）でセルの内容を声を変えて読上げ -その９- 太字部分を強調読上げする

Excel VBA（マクロ）でセルの内容を声を変えて読上げ -その１
Windowsに標準で組み込まれている読上げの声で、Harukaの声以外を使って読上げる方法
Excel VBA（マクロ）でセルの内容を声を変えて読上げ -その２
読上げ内容を音声ファイルに保存する方法
Excel VBA（マクロ）でセルの内容を声を変えて読上げ -その３
スピード、ピッチ（声の音程）、更には、強調の指示方法
Excel VBA（マクロ）でセルの内容を声を変えて読上げ -その４
実際のシートに書いた内容で読上げする事例
Excel VBA（マクロ）でセルの内容を声を変えて読上げ -その５
シートに書いた内容を録音（音声ファイルに保存する）事例
Excel VBA（マクロ）でセルの内容を声を変えて読上げ -その６
読上げる内容を調整し易くする事例
Excel VBA（マクロ）でセルの内容を声を変えて読上げ -その７
XMLタグについて追加説明
Excel VBA（マクロ）でセルの内容を声を変えて読上げ -その８- 選択範囲を読上げる
選択したセルの範囲だけを読上げる
について、紹介しました。

その８で、強調についてはセルの範囲選択では上手くできず、文章途中に強調タグ（<emph></emph>）を入れると効果が出ると書きました。
XMLタグを記述することは、あまり一般的ではありません。
そこで、文中の強調したい箇所だけ、太字にして、マクロで勝手に強調するようにしてみます。

Excelシート事例

	A	B	C	D	E
1	スピード	強調	ピッチ	話し手	内容
2	2		-3	一郎	いつもお世話になっています。早急なご対応をお願いします。
3	-1		4	あゆみ	ありがとうございます。
4	2		-2	はるか	お願いします。
5	2	Y	-2	はるか	たとえ問題が発生しても、
6	2		-2	はるか	期限は守ってください。
7	2		-2	はるか	お願いします。<emph>たとえ問題が発生しても</emph>、期限は守ってください。
8	2		-2	はるか	お願いします。たとえ問題が発生しても、期限は守ってください。

読上げSubの内容を書き換えました。
あまりスマートな記述ではありません。

Private Sub 読上げsub太字()
    'A-1:速度 B-2:強調 C-3:声色 D-4:話し手 E-5:読上げ内容
    '1列を読込
    For col = 1 To 5
        '強調文字確認
        If col = 5 Then
            Set rg = sht.Range(sht.Cells(rw, col), sht.Cells(rw, col))
            '太字交じりの文章は、BoldがNull
            If IsNull(sht.Cells(rw, col).Font.Bold) = True Then
                '文章用変数初期化
                bun = ""
                '太字フラッグ初期化
                bld = False
                '1文字目から最終文字まで
                For ch = 1 To Len(sht.Cells(rw, col))
                    '文字フォントが太字の場合
                    If sht.Cells(rw, col).Characters(ch, 1).Font.Bold = True Then
                        '太字フラッグが偽の場合（太字に切替る）
                        If bld = False Then
                            '強調タグを加えて、１文字を文書変数に追加
                            bun = bun & "<emph>" & Mid(sht.Cells(rw, col), ch, 1)
                            '太字フラッグを真に設定
                            bld = True
                        '太字継続
                        Else
                            '１文字を文書変数に追加
                            bun = bun & Mid(sht.Cells(rw, col), ch, 1)
                        End If
                    '文字フォントが太字ではない場合
                    Else
                        '太字フラッグが偽の場合（標準の継続）
                        If bld = False Then
                            '１文字を文書変数に追加
                            bun = bun & Mid(sht.Cells(rw, col), ch, 1)
                        '太字フラッグが真の場合（太字から標準に切替る）
                        Else
                            '強調終了タグを加えて、１文字を文書変数に追加
                            bun = bun & "</emph>" & Mid(sht.Cells(rw, col), ch, 1)
                            '太字フラッグを偽に設定
                            bld = False
                        End If
                    End If
                Next
                '最後まで太字なら
                If bld = True Then
                    '強調終了タグ追加
                    bun = bun & "</emph>"
                End If
                'SAPIに渡す文字を書換
                cel(5) = bun
            'セルのフォント太字がNullでは無い場合
            Else
                'SAPIに渡す文字をセル内容のまま取得
                cel(col) = sht.Cells(rw, col)
            End If
        '５列目以外
        Else
            cel(col) = sht.Cells(rw, col)
        End If
    Next
    'XML指示を初期化
    mae = ""
    ato = ""
    '速度
    Call rat(cel(1))
    '強調
    Call emp(cel(2))
    '声色
    Call pit(cel(3))
    '読み手
    Set spi.Voice = voic(tok(cel(4)))
        
    '読上げ
    spi.Speak mae & cel(5) & ato
End Sub

セルのフォントの太字属性は、

.Cells(行, 列).Font.Bold

で得られます。

すべて太字なら、「True」。すべて、標準なら、「False」。
標準に太字が混じっている場合には、「Null」となります。
そこで、「Null」の場合には、セルの文字を１文字ずつ判断して、切替り場所でタグを入れるようにしました。

If IsNull(sht.Cells(rw, col).Font.Bold) = True Then

の部分が、Null判断の行です。

もう少しスマートな記述ができると思いますが、直感的に書けていると思います。

その１０へ続く