セルの一部でも取り消し線が引かれているかをVBAで判定する

「vba 取り消し線 判定」
「EXCEL vba 取り消し線 判別」
といった検索キーワードをきっかけにして、セル全体に取り消し線が引かれているかどうかを判定するExcel VBAのコードをご紹介しました。
セルを表すRangeオブジェクトから取得したFontオブジェクトのStrikethrouphプロパティを使って、

セル全体に取り消し線が引かれているかどうかを判定するコードです。

しかし、セルの一部に取り消し線が引かれている場合は、Rangeオブジェクトから取得したFont.Strikethrougpプロパティでは判定できません。

セルの一部でも取り消し線が引かれているか判定するExcelマクロ

セルの一部でも取り消し線が引かれているかどうかを判定するには、以下のようなコードです。

Characters.Font.Strikethroughで取り消し線の判定ができる

Fontオブジェクトに用意されているStrikethroughプロパティを使うのは同じですが、

Fontオブジェクトを取得する経路が違います。
セル全体の取り消し線の場合はRange.Fontプロパティを使いましたが、

セルの一部の場合は文字列を表すCharactersオブジェクトのFontプロパティです。

セルに入力されている文字列の長さだけFor～Nextループを回して、

With ActiveCell
　For i = 1 To Len(.Value)

Rangeオブジェクトに用意されているCharactersプロパティを使って

セル内文字列を1文字ずつ順番に取得し、

　For i = 1 To Len(.Value)
　　If .Characters(i, 1).Font.Strikethrough Then

CharactersオブジェクトのFontプロパティで取得したFontオブジェクトのStrikethroughプロパティで取り消し線が引かれているか判定しています。

　For i = 1 To Len(.Value)
　　If .Characters(i, 1).Font.Strikethrough Then

取り消し線が引かれているときに、上記のExcelマクロでは、メッセージを表示してSubプロシージャを終了しています。

　　If .Characters(i, 1).Font.Strikethrough Then
　　　MsgBox "取り消し線が引かれています。"
　　　Exit Sub

For～Nextループが最後まで実行されたということは、そのセル内では一部にも取り消し線が引かれていないということですから、その旨のメッセージを表示しています。

　Next

　MsgBox "取り消し線は引かれていません。"
End With