VBA PPTの書式保持カタカナ全角変換

前回「VBA PPTのカタカナ全角変換」では、PowerPoint文書のテキストボックス文字列の中から、半角カタカナだけを対象に全角変換する処理を作成しました。しかし、文字列途中の書式などは全てリセットされてしまい、体裁が変換前とは変わってしまいました。

今回は、書式を保持したまま全角変換する処理に変えていきます。

書式保持したまま文字を変更するには

PowerPoint文書のテキストボックスの文字列は、１文字ごとに色を替えたり、下線を引いたり、文字サイズを変えるなど書式を個別に設定することができます。

例えば、文字の背景色を変えてみると、こんな感じ、

このとき、文字の背景色はPowerPoint文書ファイル内でどのように保持されているのでしょう。ちょっとPowerPoint文書ファイル内をのぞいてみます。

ご存じの方も多いと思いますが、PowerPointなどOfficeのファイル形式は、Office 2007以降、Office Open XMLというXMLをベースとしたファイルフォーマットになっており、複数のXMLファイルや写真、図のバイナリデータなどをzip圧縮したものとなっています。

PowerPoint文書ファイル名に「.zip」を追加（例えば、test.pptx.zip）して、zipをファイル展開します。フォルダ階層をたどり、例えばスライド１枚めのXMLファイル（test.pptx\ppt\slides\slide1.xml）をIEブラウザで開いてみます。

中身を見ていくと、あっ　ありました。
ｱｯﾌﾟﾙやﾏﾝｺﾞｰの文字列と一緒にFF0000やFFFF00の赤色や黄色を示すRGBコードがあります。

詳しいフォーマットの仕様は分かりませんが、文字列の書式を変更した単位で、その文字列とともに書式も保持されるような形式となっているようです。

この書式を変更せずに文字列だけを例えばｱｯﾌﾟﾙからアップルに差し替えることは可能でしょうか。

ググってみたところ、便利なメソッドが見つかりました。TextRange.Charactersです。これはテキストボックスなどの文字列から任意の文字列範囲のTextRangeオブジェクトを取得することができ、そのテキストを参照したり、設定することができます。

これを利用して、１文字ずつ全角変換して置き換えていけば書式を保持したまま全角変換ができそうです。

プログラムの作成

以下にプログラムを示します。

Option Explicit

Public Sub test4()
    Dim oApplication As Object
    Set oApplication = CreateObject("PowerPoint.Application")
    
    Dim oPresentation As Object
    Set oPresentation = oApplication.Presentations(1)
    
    Dim nIndex As Long
    nIndex = oPresentation.Windows(1).Selection.SlideRange.SlideIndex
    
    Dim oSlide As Object
    Set oSlide = oPresentation.Slides(nIndex)
    
    Dim oShape As Object
    For Each oShape In oSlide.Shapes
        Call KatakanaZenkaku(oShape.TextFrame2.TextRange)
    Next oShape
End Sub
 
Private Sub KatakanaZenkaku(oTextRange As Object)
    Dim sBackward As String: sBackward = ""     '後方文字
    Dim nPos As Integer: nPos = Len(oTextRange.Characters.Text)
    Do While 0 < nPos
        Dim sChar As String
        sChar = Mid(oTextRange.Characters.Text, nPos, 1)
        
        If sChar = "･" Or sChar = "ｰ" Or _
           sChar = "ﾞ" Or sChar = "ﾟ" Then
            sBackward = sChar & sBackward
        ElseIf IsCodeRange(sChar, "ｦ", "ｯ") Or _
               IsCodeRange(sChar, "ｱ", "ﾝ") Then
            sChar = sChar & sBackward
            Call ReplaceChar(oTextRange, nPos, sChar, vbWide)
            sBackward = ""
        Else
            sBackward = ""
        End If
        nPos = nPos - 1
    Loop
End Sub

Private Function IsCodeRange(sChar As String, _
        sMin As String, sMax As String) As Boolean
    
    IsCodeRange = _
        ((AscW(sMin) <= AscW(sChar)) And (AscW(sChar) <= AscW(sMax)))
End Function

Private Sub ReplaceChar(oTextRange As Object, nPos As Integer, _
        sChar As String, nConversion As Integer)
    
    oTextRange.Characters(nPos, Len(sChar)).Text = _
        StrConv(sChar, nConversion)
End Sub

プログラムを組み込んだExcelファイルを以下に添付します。

test4.xlsm

18.6 KB

ファイルダウンロードについて

ダウンロード

テスト用PowerPoint文書ファイル

テスト用のテキストボックス文字列を含んだPowerPoint文書ファイルを添付します。

test4.pptx

41.5 KB

ファイルダウンロードについて

ダウンロード

動作確認

上記のテスト用PowerPoint文書ファイル「test4.pptx」をダブルクリックして開き、１ページ目のスライドを表示します。

Excelファイル「test4.xlsm」の開発タブ、マクロから、
マクロ名：Sheet1.test4を実行します。

実行結果例は次のようになり、書式が保持されたまま、半角カタカナが全角変換されました。

プログラムの解説

それでは、プログラムの主な内容を説明します。

test4プロシージャの後半部は、スライド中のShapeオブジェクトを１つずつ取り出して、KatakanaZenkakuプロシージャにTextFrame2.TextRangeオブジェクトを渡して文字列中の半角カタカナを全角変換します。
なお、test4プロシージャの前半部は、前回「VBA PPTのカタカナ全角変換」の内容と同様なので説明を省略します。

Public Sub test4()
    :
    
    Dim oShape As Object
    For Each oShape In oSlide.Shapes
        Call KatakanaZenkaku(oShape.TextFrame2.TextRange)
    Next oShape
End Sub

KatakanaZenkakuプロシージャは、引数指定されたTextRangeオブジェクトの文字列の中から、半角カタカナだけを対象に全角変換します。

Private Sub KatakanaZenkaku(oTextRange As Object)
    :
End Sub

sBackwardは、半角カタカナに続くかもしれない後方文字を一時保管するための変数です。後方文字としては、中黒（･）、長音記号（ｰ）、濁音（ﾞ）、半濁音（ﾟ）があります。
半角カタカナの「ｶﾞ」や「ﾊﾟ」などは、まとめて変換せずに１文字ずつ全角変換すると、濁音（ﾞ）や半濁音（ﾟ）も１文字として全角変換され、「カ゛」や「ハ゜」となってしまうため、半角カタカナと組み合わせられるように一旦保持します。

    Dim sBackward As String: sBackward = ""     '後方文字

oTextRange.Characters.Textの文字列を末尾から先頭方向へ、１文字ずつsCharに取り出して処理します。

    Dim nPos As Integer: nPos = Len(oTextRange.Characters.Text)
    Do While 0 < nPos
        Dim sChar As String
        sChar = Mid(oTextRange.Characters.Text, nPos, 1)
        :
        nPos = nPos - 1
    Loop

sCharが後方文字の中黒（･）、長音記号（ｰ）、濁音（ﾞ）、半濁音（ﾟ）のいずれかの場合は、sBackwardに一旦保管します。後方文字が連続した場合は、前に保管した内容の前に連結して保管するようにします。

        If sChar = "･" Or sChar = "ｰ" Or _
           sChar = "ﾞ" Or sChar = "ﾟ" Then
            sBackward = sChar & sBackward

sCharが半角カタカナなら、このElseIf条件が成立します。後方文字があれば後ろに連結したうえで、ReplaceCharプロシージャでテキストボックスの文字列の該当箇所を全角変換した文字に置き換えます。また、sBackwardは空文字でリセットしておきます。

        ElseIf IsCodeRange(sChar, "ｦ", "ｯ") Or _
               IsCodeRange(sChar, "ｱ", "ﾝ") Then
            sChar = sChar & sBackward
            Call ReplaceChar(oTextRange, nPos, sChar, vbWide)
            sBackward = ""

上記の条件がいずれも成立しない場合は、単にsBackwardを空文字でリセットしておきます。

        Else
            sBackward = ""
        End If

sCharの文字が、指定の文字コード範囲内にあるかどうかを検定します。

Private Function IsCodeRange(sChar As String, _
        sMin As String, sMax As String) As Boolean
    
    IsCodeRange = _
        ((AscW(sMin) <= AscW(sChar)) And (AscW(sChar) <= AscW(sMax)))
End Function

TextRangeオブジェクトのCharactersメソッドを使用して、置換元の先頭位置と文字列の長さを指定して該当箇所のTextRangeオブジェクトを取得します。そして、そのTextRangeオブジェクトの文字列を、sCharをStrConvで全角変換した文字列に置き換えます。

Private Sub ReplaceChar(oTextRange As Object, nPos As Integer, _
        sChar As String, nConversion As Integer)
    
    oTextRange.Characters(nPos, Len(sChar)).Text = _
        StrConv(sChar, nConversion)
End Sub

さいごに

今回はPowerPoint文書のテキストボックス文字列の中から、半角カタカナだけを対象に書式を保持したまま全角変換する処理を作成しました。

次回は、以前紹介した「VBA PowerPoint文書フォント変更（ツール添付）」を流用改造して、PowerPoint文書のテキストボックスだけでなく、SmartArtや表テーブルなども対象に、英字や数字も含めて全角／半角変換ができるツールに仕上げていこうと思います。