EXCEL VBA 取り消し線（文字飾り・Strikethroughプロパティ・セルの書式設定）

2021年11月13日

EXCEL VBA 取り消し線（文字飾り・Strikethroughプロパティ・セルの書式設定）

●はじめに

今回説明するのは、取り消し線（文字飾り）Strikethroughプロパティの説明を致します。EXCELでは、取り消し線は、【セルの書式設定】の【文字飾り】にて設定する事が出来ます。ここのチェックボックスにチェックを付ける事で文字列等に取り消し線を付けたり外したりする事が出来ます。下記のサンプルプログラムでは、取り消し線（Strikethroughプロパティ）を使った利用方法をサンプルプログラムを交えて説明いたします。

●【EXCEL VBA セルの文字配置（横位置・縦位置・水平位置・垂直位置・セルの書式設定）は、下記を参照して下さい】

EXCEL VBA セルの文字配置（横位置・縦位置・水平位置・垂直位置・セルの書式設定）

●【EXCEL VBA セルの文字配置（横書き・縦書きの指定・折り返しの指定・セルの書式設定）

は、下記を参照して下さい】

EXCEL VBA セルの文字配置（横書き・縦書きの指定・折り返しの指定・セルの書式設定）

●【Strikethroughプロパティについては、下記を参照して下さい（Microsoft社　様）】
https://docs.microsoft.com/ja-jp/office/vba/api/excel.font.strikethrough

●書式の説明　（Strikethroughプロパティ：取り消し線）

●　Strikethroughプロパティを利用するには、下記の通りに設定を行います。

Rangeオブジェクト.Strikethrough
Rangeオブジェクト.Strikethrough　＝　設定値

【使用例】（取り消し線を設定・解除）

'
'
Sub Strikethrough01() '取り消し線を設定

    Range("A1").Font.Strikethrough = True

End Sub
'

'
'
Sub Strikethrough02() '取り消し線を解除

    Range("A1").Font.Strikethrough = False

End Sub
'

Sub Strikethrough01() '取り消し線を設定

Range("A1").Font.Strikethrough = True

End Sub

Sub Strikethrough02() '取り消し線を解除

Range("A1").Font.Strikethrough = False

End Sub

【使用例】（取り消し線の設定値取得）

【注意点】

●Strikethroughプロパティで設定値を取得する場合は、変数の宣言をBoolean ブール型で宣言します。真 (True) または偽 (False)のいずれかが代入されます。）
●セル範囲内で、Strikethroughプロパティを使って設定値（True・False）を取得する際は、必ず取り消し線が設定を統一にしておく必要が有ります。設定値が混在していると設定値を取得する際にエラーが発生しますので、注意してください。※エラー対策等が必要

EXCEL VBA 取り消し線（文字飾り・Strikethroughプロパティ）※取り消しを設定/解除

●プログラム説明　(サンプル①)

下記のサンプルプログラムは、取り消し線（Strikethroughプロパティ）を使って、セルに登録された文字列（範囲指定されたセル）に対して取り消し線を付けたり解除を繰り返すサンプルプログラムです。

・セルA1:C5の範囲の文字列に対して取り消し線を【設定】⇔【解除】を繰り返します。
（設定状態だと解除・解除状態だと設定します）

【プログラムの流れ】
下記のサンプルプログラムは、①Aと①Bと2つのプログラムがありますが、処理内容は同じです。
（プログラムの記述方法が違うだけです）

・サンプルプログラム①Aパターン
①　セル（A1:C3）範囲から取り消し線の設定内容（True又はFalse）を取得してAnsへ代入します。
②　Ansへ取得した取り消し線の設定を判定します。（取り消し線がTrueは、設定済・Falseは、未設定）
③　Trueの場合は、取り消し線を解除します（Falseへ変更）または、Falseの場合は、取り消し線を設定します（Trueへ変更）

【プログラム実行条件】
●　セルA1:C３の取り消し線の設定は、「True」又は、「False」のいずれかで必ず統一した内容で設定する必要があります。（セル範囲の取り消し線の設定内容がTrue・Falseが混在していると変数に代入する時にエラーが発生します。）

★【サンプルプログラム】
下記のリンク先よりサンプルプログラムをダウンロードする事ができます。
●　Strikethrough①

●　サンプルプログラム①Ａパターン

'
'
Sub Strikethrough10A()  '取り消しを一括設定/解除（Aパータン）

   Dim Ans As Boolean  '取得する変数を設定（Boolean：TrueとFalseを格納）
        
    Ans = Range("A1:C3").Font.Strikethrough  'セル（A1：C3）の範囲から取り消し線の設定値を取得（Ans）します。
                                            '（取り消し線がTrueは、設定済・Falseは、未設定）
                                            
    If Ans = True Then  '取得した取り消し線の取得値を判定します。
            Range("A1：C3").Font.Strikethrough = False  'Trueの場合は、取り消し線を解除します（False）
         Else
            Range("A1：C3").Font.Strikethrough = True  'Falseの場合は、取り消し線を設定します（True）
    End If

End Sub
'

Sub Strikethrough10A() '取り消しを一括設定/解除（Aパータン）

Dim Ans As Boolean '取得する変数を設定（Boolean：TrueとFalseを格納）

Ans = Range("A1:C3").Font.Strikethrough 'セル（A1：C3）の範囲から取り消し線の設定値を取得（Ans）します。

'（取り消し線がTrueは、設定済・Falseは、未設定）

If Ans = True Then '取得した取り消し線の取得値を判定します。

Range("A1：C3").Font.Strikethrough = False 'Trueの場合は、取り消し線を解除します（False）

Else

Range("A1：C3").Font.Strikethrough = True 'Falseの場合は、取り消し線を設定します（True）

End If

End Sub

●　サンプルプログラム①Ｂパターン

'
'
Sub Strikethrough10B()  '取り消しを一括設定/解除（Bパターン）

    Dim Ans As Boolean '取得する変数を設定（Boolean：TrueとFalseを格納）
    
    Ans = Not Range("A1：C3").Font.Strikethrough
    'セル（A1：C3）の範囲から取り消し線の逆の設定値を取得（Ans）します。
    'Falseの場合は、Trueを返します。
    'Trueの場合は、Falseを返します。
    
    Range("A1：C3").Font.Strikethrough = Ans
    'セル（A1:C3）の範囲へ取り消し線を設定又は、解除を設定します。
    
End Sub
'

Sub Strikethrough10B() '取り消しを一括設定/解除（Bパターン）

Dim Ans As Boolean '取得する変数を設定（Boolean：TrueとFalseを格納）

Ans = Not Range("A1：C3").Font.Strikethrough

'セル（A1：C3）の範囲から取り消し線の逆の設定値を取得（Ans）します。

'Falseの場合は、Trueを返します。

'Trueの場合は、Falseを返します。

Range("A1：C3").Font.Strikethrough = Ans

'セル（A1:C3）の範囲へ取り消し線を設定又は、解除を設定します。

End Sub

●実行前～実行後　※プログラム実行後、セル範囲（A1:C3）取り消し線の設定値を取得して、取り消し線を設定済（True）の場合は、解除（False）・未設定（False）の場合は設定（True）に変更して取り消し線を引きます。
（画面クリックして拡大）

EXCEL VBA 取り消し線（文字飾り・Strikethroughプロパティ）※ダブルクリックで取り消し線を引く・更にダブルクリックで取り消し線を解除

●プログラム説明　(サンプル②)

下記のサンプルプログラムは、取り消し線（Strikethroughプロパティ）を使って、選択したセルでダブルクリックを行うと取り消し線を設定して、取り消し線が設定されているセルでダブルクリックで取り消し線を削除（解除）するサンプルプログラムで、今回のサンプルプログラムはイベントプロシージャを利用してダブルクリックを行ったシート及びセルに対して実行します。

【プログラム実行条件】
●下記のサンプルプログラムは、イベントプロシージャを利用してプログラムを登録しています。

【プログラムの流れ】
①　文字列が登録しているセルでダブルクリックします。
②　ダブルクリックしたセルの設定値を取得し、その逆の設定を取得します。
・取り消し線が設定されていれば、True　⇒　False　③で設定する
・取り消し線が未設定の場合は、False　⇒　True　③で設定する。
③　ダブルクリックしたセルに取り消し線が未設定の場合は、設定し取り消し線を引きます。

★【サンプルプログラム】
下記のリンク先よりサンプルプログラムをダウンロードする事ができます。

●　Strikethrough②

'
'
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)


    Dim Ans As Boolean '取得する変数を設定（Boolean：TrueとFalseを格納）
    
    Ans = Not ActiveCell.Font.Strikethrough
    '選択セルの取り消し線の設定値の逆を取得（Ans）します。
    'Falseの場合は、Trueを返します。
    'Trueの場合は、Falseを返します。
    
    ActiveCell.Font.Strikethrough = Ans
    '選択セルの取り消し線を設定又は、解除を設定します。

End Sub
'
'

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

Dim Ans As Boolean '取得する変数を設定（Boolean：TrueとFalseを格納）

Ans = Not ActiveCell.Font.Strikethrough

'選択セルの取り消し線の設定値の逆を取得（Ans）します。

'Falseの場合は、Trueを返します。

'Trueの場合は、Falseを返します。

ActiveCell.Font.Strikethrough = Ans

'選択セルの取り消し線を設定又は、解除を設定します。

End Sub

●実行前～実行後　※ダブルクリックした文字列が登録されているセルに対して、取り消し線を設定・未設定（解除）を繰り返します。
（画面クリックして拡大）

EXCEL VBA 取り消し線（文字飾り・Strikethroughプロパティ）※条件に一致するデータに対して取り消し線を引く

●プログラム説明　(サンプル③)

下記のサンプルプログラムは、取り消し線（Strikethroughプロパティ）を使って、条件に一致するデータに対して、取り消し線を引くサンプルプログラムです。

【プログラムの流れ】
①　ワークシート「社員住所録」の取り消し線を全て解除します。
②　ワークシート「退職リスト」B列の最終行を取得します。
③　ワークシート「社員住所録」B列の最終行を取得します。
④　ワークシート「退職リスト」のB列最終行まで繰り返します。
⑤　Match関数で該当データが無い場合エラーが発生がするので、エラーが発生を無視します。
⑥　ワークシート「退職リスト」のB列「氏名」からワークシート「社員住所録」のB列「氏名」に該当する氏名が有るか検索します。※該当する行番号を取得します。
⑦　該当する氏名が有る場合は、その該当する行番号のデータA列～E列まで取り消し線を引きます⑧　該当する氏名が無い場合は、該当しない氏名のメッセージを表示します。
⑨　ワークシート「退職リスト」のB列データが無くなるまで繰り返します。⑥へ
⑩　ワークシート「社員住所録」をアクティブにします。（前面表示）

【プログラム実行条件】

●　ワークシート「退職リスト」を作成する。B列には必ず「氏名」を登録します。
●　ワークシート「社員住所録」を作成する。B列には必ず「氏名」を登録します。
※処理条件は「氏名」で判断します。

★【サンプルプログラム】
下記のリンク先よりサンプルプログラムをダウンロードする事ができます。

●　Strikethrough③

'
'
Sub Strikethrough30() '条件に一致した該当データに対して取り消し線を引く

    Dim ws01, ws02 As Worksheet
    Dim I, lRow, mRow, xRow As Long
  
    Set ws01 = Worksheets("退職リスト")
    Set ws02 = Worksheets("社員住所録")
 
    ws02.Cells.Font.Strikethrough = False 'シート「社員住所録」
    
    lRow = ws01.Cells(Rows.Count, "B").End(xlUp).Row 'シート「退職リスト」B列の最終行を取得します。
    xRow = ws02.Cells(Rows.Count, "B").End(xlUp).Row ' シート「社員住所録」B列の最終行を取得します。
    
    For I = 2 To lRow 'シート「退職リスト」のB列最終行まで繰り返します。
    
        mRow = 0
        On Error Resume Next  'エラーが発生を無視します。
        mRow = WorksheetFunction.Match(ws01.Cells(I, "B"), ws02.Range("B2:B" & xRow), 0) + 1
        'シート「退職リスト」から該当社員をシート「社員住所録」から探し、該当行を取得します。
        On Error GoTo 0
        
        If mRow <> 0 Then  '該当社員がいる場合は、該当する行番号があるか確認します。
            ws02.Range("A" & mRow & ":E" & mRow).Font.Strikethrough = True
            '該当するデータにA列～E列まで取り消し線を引きます。
                Else
            MsgBox "社員住所録には、該当するデータ【" & ws01.Cells(I, "B") & "】がありません。"
            '行番号が０の場合は、該当するデータが無いのでメッセージを表示します。
        End If
    Next I
    
    ws02.Activate  'シート「社員住所録」をアクティブにします。（前面表示）
    
End Sub
'
'

Sub Strikethrough30() '条件に一致した該当データに対して取り消し線を引く

Dim ws01, ws02 As Worksheet

Dim I, lRow, mRow, xRow As Long

Set ws01 = Worksheets("退職リスト")

Set ws02 = Worksheets("社員住所録")

ws02.Cells.Font.Strikethrough = False 'シート「社員住所録」

lRow = ws01.Cells(Rows.Count, "B").End(xlUp).Row 'シート「退職リスト」B列の最終行を取得します。

xRow = ws02.Cells(Rows.Count, "B").End(xlUp).Row ' シート「社員住所録」B列の最終行を取得します。

For I = 2 To lRow 'シート「退職リスト」のB列最終行まで繰り返します。

mRow = 0

On Error Resume Next 'エラーが発生を無視します。

mRow = WorksheetFunction.Match(ws01.Cells(I, "B"), ws02.Range("B2:B" & xRow), 0) + 1

'シート「退職リスト」から該当社員をシート「社員住所録」から探し、該当行を取得します。

On Error GoTo 0

If mRow <> 0 Then '該当社員がいる場合は、該当する行番号があるか確認します。

ws02.Range("A" & mRow & ":E" & mRow).Font.Strikethrough = True

'該当するデータにA列～E列まで取り消し線を引きます。

Else

MsgBox "社員住所録には、該当するデータ【" & ws01.Cells(I, "B") & "】がありません。"

'行番号が０の場合は、該当するデータが無いのでメッセージを表示します。

End If

Next I

ws02.Activate 'シート「社員住所録」をアクティブにします。（前面表示）

End Sub

●実行前～実行後　※プログラム実行後、ワークシート「退職リスト」のB列「氏名」を元に、ワークシート「社員住所録」に登録されているB列の「氏名」の中から該当する「氏名」を検索します。退職リストに該当する氏名が有れば、社員住所録のデータに取り消し線を引きます。なお、該当する氏名が無い場合は、メッセージボックスにて該当データが無い事を表示します。
（画面クリックして拡大）