EXCELで取り消し線（Font.Strikethrough = True）が有効にならないデバッグ

サンプルコードを参考にさせて頂き、VBAにてリストのファイル名から任意のフォルダにあるPDF図面を順番に自動で印刷するEXCELファイルを作っております。

ほぼ出来ていると思うのですが、コードの末尾から14,15行目の
'文字に取り消し線を設定
Cells(i, r).Font.Strikethrough = True
で引っ掛かり、何度見直し、分かる範囲で試してみても有効になりません。
ENDまで有効にするにはどう変えれば良いか、ご存じの方ご教示お願い致します。

Sub ListPrint() '図面印刷VBA
     
    'Shell実行用の変数設定
    Dim wshShellObj As IWshRuntimeLibrary.WshShell 'Shellオブジェクト
    Set wshShellObj = New IWshRuntimeLibrary.WshShell
    Dim strShellCommand As String  'Shellコマンド
    Const folderPath = "C:\Users\Desktop\サンプル"  'フォルダパス（定数)
    Dim printFolderPath As String  'フォルダパス
    Dim printFileName As String  'ファイル名
    Dim printFilePath As String  'ファイルパス
    Dim activePrinter As String '通常使うプリンターを取得
    Dim printerName As String 'プリンタ名
    Dim listname As String '印刷リスト
    Dim listFolder As String '印刷リストフォルダ名
    Dim intPoint1 As Long 'プリンタ名を切り出す為の文字数
    Dim i As Integer '印刷行カウンター
     
    '通常使うプリンターを取得
    activePrinter = Application.activePrinter
    '取得できなかった時の処理
    If activePrinter = "" Then
        MsgBox "プリンター情報が取得できませんでした" & Chr(13) & "プリンターが接続されていることを確認してください"
        End
        Exit Sub
    End If
 
    'ファイル名（" on"の前まで）とポート名("on "の後から最後まで）を切り出す
    intPoint1 = InStr(activePrinter, "on") - 2
 
    'プリンター名を指定
    printerName = Left(activePrinter, intPoint1) 'ポートを除いたプリンタ名
     
    'カウンターをセット A列1行目から
    i = 1 '行
     
    '表紙の最初の図番を取得
    listname = Cells(i, 1).Value
 
    Do While listname <> ""
        'PDFファイルパスを設定
        printFolderPath = folderPath & listFolder & listname   '印刷するPDFフォルダパス
        'PDFファイル名を取得（拡張子などをワイルドカードで検索して変数へ取込む）
        printFileName = Dir(printFolderPath & "*")
         
        'ファイルがあるかを判定
        If printFileName <> "" Then
            'ファイルパスを指定
            printFilePath = folderPath & listFolder & printFileName
            'Shellコマンドを設定
            strShellCommand = "AcroRd32.exe /t " & printFilePath & " " & printerName '設定画面を表示
            'Shellコマンドを実行
            wshShellObj.Run (strShellCommand)
             
            '文字を赤色に変更
            Cells(i, r).Font.Color = RGB(255, 0, 0)
        Else
            '文字に取り消し線を設定
            Cells(i, r).Font.Strikethrough = True
        End If
 
        '1行下がる
        i = i + 1
         
        '次のリストを取得
        listname = Cells(i, 1).Value
         
    Loop
     
    'オブジェクトを強制開放
    Set wshShellObj = Nothing
 
End Sub

エラー画面

ファイル実行画面

検索するフォルダ

Usirow

2022/05/17 08:23

これ、rには何の値が入っているのでしょうか？

RANDS_CHANP

2022/05/17 08:36

有難うございます。私も気にはなっていたのですが、ここは正直サンプルコードを丸写しした形です。サンプルコードにもrに関連するような構文が無かったのですが、どう置き換えれば良いか分からずそのまま走らせてみた次第です。その下の方の、一行下がるの構文がrで無ければいけないのでしょうか。理解出来ておらず申し訳ございません。宜しければご教示頂けると幸いです。