常連

### 実現したいこと
エラーを解決したい。

### 発生している問題・分からないこと
コード実行するとオブジェクトが必要となります。
恐らく代入時の型が不一致だと思うのですが、対処がわかりません。
セルB3は文字列、変数codeはStringとしています。

調べるとこのエラーはFAQのようですが、わかりませんでした。

### エラーメッセージ
```error
実行時エラー　４２４
オブジェクトが必要です、
```

### 該当のソースコード

```excel2019VBA
Public mOnTime As Date
'Dim code As String

Sub timer_read()

    Dim ct, count, lines
    Dim strFilePath As String
    Dim i, temp
    Dim code As String

　   Worksheets("Sheet1").Activate
    
    count = Sheet1.Range("f3")
    ct = Sheet1.Range("g3") + 1
    
'    Worksheets("Sheet3").Activate
    code = Sheet3.Cells(ct, 1).Text    
    If code = "0" Then
        Call OnTimeStop
    End If
    
    
    Worksheets("Sheet1").Activate
    Set Sheet1.Range("b3").Text = code　　　　←オブジェクトが必要のエラー４２４
    
    If ct >= Sheet1.Range("f3") Then
        Call OnTimeStop
    End If
   
End Sub

```

### 試したこと・調べたこと
- [x] teratailやGoogle等で検索した
- [x] ソースコードを自分なりに変更した
- [ ] 知人に聞いた
- [ ] その他

##### 上記の詳細・結果
次のようなコードの変更を試した
Set Sheet1.Range("b3").string = code
Sheet1.Range("b3") = code
Sheet1.Range("b3").Text = code
コードの２行目を有効（例示コードではコメントアウト）

当初はセルB3を数値として、codeも数値としていた時は、問題ありませんでした。


### 補足
特になし

excel　vba　オブジェクトが必要とのエラーの解決

### 実現したいこと
Microsoft Access 2021(.accdb)で作成したaccessファイルを他のPCにあるMicrosoft Access 2016 runtimeで起動したいのですが、エラーが発生してしまい実行することができません。
自分のPCで開いた時には発生しなかったのですが、どうすれば解決できるでしょうか？
初心者で申し訳ございませんが、ご教授の方よろしくお願いします。

### 発生している問題・分からないこと
テーブルを開きボタンをクリック時に発生するVBAが実行されると、下記のエラーが発生しています。
自分のパソコンではエラーは表示されず実行できましたが、別のパソコンで同じaccessのデータを実行時にエラーが出ました。

### エラーメッセージ
```error
「実行時エラーが発生したため、このアプリケーションの実行は中断しました。
アプリケーションを続行できません。システムはシャットダウンされます。」
```

### 該当のソースコード

```
'ボタンを押した際のイベント
Private Sub btnログイン_Click()

    Dim strSQL As String
    Dim rs As ADODB.Recordset
    Dim cn As ADODB.Connection
    Dim str社員コード As String
    Dim strパスワード As String
    Dim int権限区分 As Integer
    

        str社員コード = Me.txt社員コード & ""
        strパスワード = Me.txtパスワード & ""
        
        strSQL = "SELECT [社員リスト].[社員コード], [社員リスト].[社員名], [パスワードリスト].[パスワード], [パスワードリスト].[権限区分]"
        strSQL = strSQL & "FROM [社員リスト] LEFT JOIN [パスワードリスト] ON [社員リスト].[社員コード] = [パスワードリスト].[社員コード]"
        strSQL = strSQL & "WHERE [社員リスト].[社員コード] = '" & str社員コード & "' AND [パスワードリスト].[パスワード] = '" & strパスワード & "' "


        'Call ADO内部接続 'またはADO外部接続
        Set cn = CurrentProject.AccessConnection
        Set rs = New ADODB.Recordset
        rs.Open strSQL, cn, adOpenKeyset, adLockOptimistic
        
        If rs.EOF = False Then
         
         MsgBox "ようこそ"
         int権限区分 = rs![権限区分]
         
         'メニューを開く
        DoCmd.OpenForm "メインメニュー"
        
        '権限を確認して「環境設定ボタン」を制御する
        If int権限区分 = 9 Then '0:一般ユーザー　9:管理者
            Forms.メインメニュー.btn設定.Enabled = True
        Else
            Forms.メインメニュー.btn設定.Enabled = False
        End If
        
         'この画面を閉じる
        DoCmd.Close acForm, Me.Name
         
        Else
        
         MsgBox "データは存在しません"
         
        End If
        
        rs.Close: Set rs = Nothing
        cn.Close: Set cn = Nothing
        
        
End Sub

'フォームの[開く時]イベントの処理
Public Function RefreshAllTableLinks() As Boolean
On Error GoTo Err_RefreshAllTableLinks

    '既定の戻り値（失敗時）は False
    RefreshAllTableLinks = False

    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim strConnect As String
    Dim lngRefreshedCount As Long

    strConnect = "ODBC;DRIVER=SQL Server との接続に用いるドライバー名;" & _
                 "SERVER=SQL Server インスタンス名;" & _
                 "UID=接続ユーザー名;" & _
                 "PWD=パスワード;" & _
                 "DATABASE=データベース名;"

    Debug.Print strConnect

    Application.Echo False, "リンクテーブルの再リンクを実行しています"

    'カレントデータベースの参照
    Set db = CurrentDb

    'データベースの全てのテーブル定義を順次参照する
    For Each tdf In db.TableDefs
        'ODBCリンクテーブルである場合
        If (Not tdf.Name Like "MSys*") And (tdf.Connect Like "ODBC;*") Then
            Debug.Print "テーブル定義[" & tdf.Name & "]を参照中"
            '接続文字列を更新
            tdf.Connect = strConnect
            'リンクのリフレッシュ
            tdf.RefreshLink
            '再リンクカウンターをインクリメント
            lngRefreshedCount = lngRefreshedCount + 1
            Debug.Print "再リンク成功"
        End If
    Next

    Debug.Print lngRefreshedCount & " 個のリンクテーブルの再リンクを実行しました。"

    Application.Echo False, "パススルークエリの接続文字列の再設定を実行しています"

    Dim qdf As DAO.QueryDef

    lngRefreshedCount = 0

    'データベースの全てのクエリ定義を順次参照する
    For Each qdf In db.QueryDefs
        'パススルークエリである場合
        If (qdf.Type = dbQSQLPassThrough) And (qdf.Connect Like "ODBC;*") Then
            Debug.Print "パススルークエリ[" & qdf.Name & "]を参照中"
            '接続文字列を更新
            qdf.Connect = strConnect
            '再リンクカウンターをインクリメント
            lngRefreshedCount = lngRefreshedCount + 1
            Debug.Print "接続文字列の再設定成功"
        End If
    Next

    Debug.Print lngRefreshedCount & " 個のパススルークエリの接続文字列の再設定を実行しました。"

    '全て成功したら True を返す
    RefreshAllTableLinks = True

Exit_RefreshAllTableLinks:

    Application.Echo True, ""

    Set tdf = Nothing
    Set db = Nothing

    Exit Function

'エラー時処理
Err_RefreshAllTableLinks:

    Application.Echo True, ""

    Dim strErrMsg As String

    strErrMsg = "再リンク処理中に以下の実行時エラーが発生しました。" & vbCrLf & _
                Err.Number & ": " & Err.Description

    Debug.Print strErrMsg

    MsgBox strErrMsg, _
           vbCritical, _
           "実行時エラー（RefreshAllTableLinks）"
           
    Resume Exit_RefreshAllTableLinks
End Function


'フォームの[開く時]イベント
Private Sub Form_Open(Cancel As Integer)
    
    'リンクテーブルの再リンク処理を実行
    If RefreshAllTableLinks() = False Then
        '失敗した場合はこのイベントをキャンセルする（このフォームを開くのを止める）
        Cancel = True
        Exit Sub
    End If

End Sub
```

### 試したこと・調べたこと
- [x] teratailやGoogle等で検索した
- [x] ソースコードを自分なりに変更した
- [ ] 知人に聞いた
- [ ] その他

##### 上記の詳細・結果
https://t-yumi.jp/gengo/access/201809251222501031.html
→Set rec = db.OpenRecordset(strSql, dbOpenDynaset)がないため変更不可

https://pentan.net/access-pro-runtime-kidouhouhou/
→自分のPCで.accdrに変更し実行したがエラーは起きなかった

・再起動→意味なし
・データベースの最適化、修復→意味なし

### 補足
自分のPC
Microsoft Access 2021(.accdb)
・ODBC 　プラットフォーム　32/64ビット ドライバー　　SQL Server
・リンクテーブルにてODBC接続
・Windows11
・64bit
・参照設定
![イメージ説明](https://ddjkaamml8q8x.cloudfront.net/questions/2024-04-22/9a552845-1add-455e-be23-32640a7832ef.png)

エラーが起きるPC
・Microsoft Access 2016 runtime
・Windows11

Access2016runtimeでのエラー　実行時エラーが発生したため、このアプリケーションの実行は中断しました。　

### 実現したいこと
If文の中の同じ処理を簡潔に書きたい

### 発生している問題・分からないこと
If文の中に同じコードがあるのでcall文で呼び出してコードを綺麗にしたいのですが上手く出来ません。
引数を使うことはわかってるのですが、上手く呼び出せない。



### 該当のソースコード

```
Set Rc1 = CurrentDb.OpenRecordset("T_会場")

Set Rc2 = CurrentDb.OpenRecordset("SELECT * FROM WK_会場マスター ORDER BY 会場コード")

Set Rc3 = CurrentDb.OpenRecordset("T_会場エラーリスト")

   

    If Rc2.RecordCount > 0 Then

        Do Until Rc2.EOF = True

            Err_flg = False

           

            

            If Len(Trim(Rc2![受験地区])) > 5 Then

           

                Rc3.AddNew

                Rc3![試験実施日] = Rc2![試験実施日]

                Rc3![会場コード] = Rc2![会場コード]

                Rc3![項目名] = "受験地区"

                Rc3![項目内容] = Rc2![受験地区]

                Rc3![文字数] = Len(Rc2![受験地区])

                Rc3.Update

                Err_flg = True

            End If

           

            

            If Len(Trim(Rc2![会場名])) > 30 Then

           

                Rc3.AddNew

                Rc3![試験実施日] = Rc2![試験実施日]

                Rc3![会場コード] = Rc2![会場コード]

                Rc3![項目名] = "会場名"

                Rc3![項目内容] = Rc2![会場名]

                Rc3![文字数] = Len(Rc2![会場名])

                Rc3.Update

                Err_flg = True

            End If

          

           

            If Len(Trim(Rc2![会場名略])) > 20 Then

           

                Rc3.AddNew

                Rc3![試験実施日] = Rc2![試験実施日]

                Rc3![会場コード] = Rc2![会場コード]

                Rc3![項目名] = "会場名略"

                Rc3![項目内容] = Rc2![会場名略]

                Rc3![文字数] = Len(Rc2![会場名略])

                Rc3.Update

                Err_flg = True

            End If

           

            

            If Len(Trim(Rc2![所在地])) > 30 Then

           

                Rc3.AddNew

                Rc3![試験実施日] = Rc2![試験実施日]

                Rc3![会場コード] = Rc2![会場コード]

                Rc3![項目名] = "所在地"

                Rc3![項目内容] = Rc2![所在地]

                Rc3![文字数] = Len(Rc2![所在地])

                Rc3.Update

                Err_flg = True

            End If

           

            

            If Len(Trim(Rc2![交通手段1])) > 30 Then

           

                Rc3.AddNew

                Rc3![試験実施日] = Rc2![試験実施日]

                Rc3![会場コード] = Rc2![会場コード]

                Rc3![項目名] = "交通手段1"

                Rc3![項目内容] = Rc2![交通手段1]

                Rc3![文字数] = Len(Rc2![交通手段1])

                Rc3.Update

                Err_flg = True

            End If

           

            

            If Len(Trim(Rc2![交通手段2])) > 30 Then

           

                Rc3.AddNew

                Rc3![試験実施日] = Rc2![試験実施日]

                Rc3![会場コード] = Rc2![会場コード]

                Rc3![項目名] = "交通手段2"

                Rc3![項目内容] = Rc2![交通手段2]

                Rc3![文字数] = Len(Rc2![交通手段2])

                Rc3.Update

                Err_flg = True

            End If

           

            

            If Len(Trim(Rc2![交通手段3])) > 30 Then

           

                Rc3.AddNew

                Rc3![試験実施日] = Rc2![試験実施日]

                Rc3![会場コード] = Rc2![会場コード]

                Rc3![項目名] = "交通手段3"

                Rc3![項目内容] = Rc2![交通手段3]

                Rc3![文字数] = Len(Rc2![交通手段3])

                Rc3.Update

                Err_flg = True

            End If

           

            

'            If Err_flg = False Then

                RC1.AddNew

                RC1![会場コード] = Rc2![会場コード]

                RC1![受験地] = Rc2![受験地区]

                'RC1![場] = "不使用項目"

                RC1![会場名] = StrConv(Rc2![会場名], vbWide)

                RC1![会場名略] = StrConv(Rc2![会場名略], vbWide)

                RC1![所在地] = StrConv(Rc2![所在地], vbWide)

                RC1![交通手段1] = StrConv(Rc2![交通手段1], vbWide)

                RC1![交通手段2] = StrConv(Rc2![交通手段2], vbWide)

                RC1![交通手段3] = StrConv(Rc2![交通手段3], vbWide)

                RC1.Update

'            End If

           

            Rc2.MoveNext

           

        Loop

   

    End If

           

End Function
```

### 試したこと・調べたこと
- [x] teratailやGoogle等で検索した
- [ ] ソースコードを自分なりに変更した
- [ ] 知人に聞いた
- [ ] その他

##### 上記の詳細・結果
Functionプロシージャに渡す値を変えて、繰り返す処理にしたいが引数が上手く渡せなかった。

### 補足
Function 会場データインポート(WK_会場)

 

 

    Dim XLAPP As Object

    Dim varFLName As Variant

    Dim FLName As String

    Dim Rc1 As Recordset

    Dim Rc2 As Recordset

    Dim Rc3 As Recordset

    Dim SQL As String

    Dim MsgTitle As String

    Dim FilePath As String

    Dim WK_ROW As Integer

    Dim ST_ROW As Integer

    Dim WK_COL As Integer

    Dim WK_COL2 As Integer

    Dim Str_SQL As String

    Dim Err_flg As Boolean

    Dim 会場データ As String

   

    

'エラーリスト作成

'WK_会場マスター→T_会場へ

 

Set Rc1 = CurrentDb.OpenRecordset("T_会場")

Set Rc2 = CurrentDb.OpenRecordset("SELECT * FROM WK_会場マスター ORDER BY 会場コード")

Set Rc3 = CurrentDb.OpenRecordset("T_会場エラーリスト")

 

    If Rc2.RecordCount > 0 Then

        Do Until Rc2.EOF = True

        Err_flg = False

           

            If Len(Trim(Rc2![受験地区])) > 5 Then

                会場データ = "Rc2[受験地区]"

                Call エラーデータインポート(会場データ)

            End If

 

            If Len(Trim(Rc2![会場名])) > 30 Then

                会場データ = "Rc2[会場名]"

                Call エラーデータインポート(会場データ)

            End If

 

            If Len(Trim(Rc2![会場名略])) > 20 Then

                会場データ = "Rc2[会場名略]"

                Call エラーデータインポート(会場データ)

            End If

 

            If Len(Trim(Rc2![所在地])) > 30 Then

                会場データ = "Rc2[所在地]"

                Call エラーデータインポート(会場データ)

            End If

 

            If Len(Trim(Rc2![交通手段1])) > 30 Then

                会場データ = "Rc2[交通手段1]"

                Call エラーデータインポート(会場データ)

            End If

 

            If Len(Trim(Rc2![交通手段2])) > 30 Then

                会場データ = "Rc2[交通手段2]"

                Call エラーデータインポート(会場データ)

            End If

 

            If Len(Trim(Rc2![交通手段3])) > 30 Then

                会場データ = "Rc2[交通手段3]"

                Call エラーデータインポート(会場データ)

            End If

           

            

'            If Err_flg = False Then

                Rc1.AddNew

                Rc1![会場コード] = Rc2![会場コード]

                Rc1![受験地] = Rc2![受験地区]

                'RC1![場] = "不使用項目"

                Rc1![会場名] = StrConv(Rc2![会場名], vbWide)

                Rc1![会場名略] = StrConv(Rc2![会場名略], vbWide)

                Rc1![所在地] = StrConv(Rc2![所在地], vbWide)

                Rc1![交通手段1] = StrConv(Rc2![交通手段1], vbWide)

                Rc1![交通手段2] = StrConv(Rc2![交通手段2], vbWide)

                Rc1![交通手段3] = StrConv(Rc2![交通手段3], vbWide)

                Rc1.Update

'            End If

           

            Rc2.MoveNext

           

        Loop

   

    End If

           

Exit_会場データインポート:

   

    'Set DB = Nothing

    Set Rc1 = Nothing

    Set Rc2 = Nothing

    Set Rc3 = Nothing

    Set XLAPP = Nothing

    Set XLWRKBK = Nothing

    Set XLWRKSH = Nothing

   

    Exit Function

       

Err_会場データインポート:

 

    'エクセルのフリーズ防止

    If XLAPP Is Nothing Then

    Else

        XLAPP.Quit

        Set XLAPP = Nothing

    End If

       

    MsgBox "システムエラー 担当者に連絡して下さい。" & vbCrLf & Err.Description, vbOKOnly + vbCritical, MsgTitle

    Resume Exit_会場データインポート

   

End Function

 

 

'Callで呼び出し

 

Public Function エラーデータインポート(Optional 会場データ As String)

 

    Dim Err_flg As Boolean

   

    If Err_flg = False Then: Exit Function

   

Set Rc2 = CurrentDb.OpenRecordset("SELECT * FROM WK_会場マスター ORDER BY 会場コード")

Set Rc3 = CurrentDb.OpenRecordset("T_会場エラーリスト")

   

    Rc3.AddNew

    Rc3![試験実施日] = Rc2![試験実施日]

    Rc3![会場コード] = Rc2![会場コード]

    Rc3![項目名] = "会場データ"

    Rc3![項目内容] = Rc2!["会場データ"]

    Rc3![文字数] = Len(Rc2!["会場データ"])

    Rc3.Update

    Err_flg = True

 

End Function

 

Public Function Err_flg() As Boolean

    Set Rc3 = CurrentDb.OpenRecordset("T_会場エラーリスト")

 

    If Rc3.RecordCount > 0 Then

        Err_flg = True

    Else

        Err_flg = False

    End If

 

End Function

If文の中の同じ処理を簡潔に書きたい。Functionプロシージャに渡す値を変えて、繰り返す処理にしたいが引数が上手く渡せなかった。

### 実現したいこと
Access VBAにて、特定の文字（"+"）があった場合、特定の文字（"+"）より前を抽出し
無い場合は空欄を返す処理を書きたいです。

例）

abcd+1234　⇒　abcd
abcd1234　  ⇒　（空欄）


### 発生している問題・分からないこと
Access VBAにて、特定の文字があった場合の切り出し方法が分からない。



### 該当のソースコード

```
特になし
```

### 試したこと・調べたこと
- [x] teratailやGoogle等で検索した
- [ ] ソースコードを自分なりに変更した
- [ ] 知人に聞いた
- [ ] その他

##### 上記の詳細・結果
以下のようにinstrやleft関数を用いているのですが、構文エラーになってしまいます。
Left("カラム名", InStr("カラム名", "+") - 1)

### 補足
特になし

Access VBA 特定の文字より前を抽出したい

### 実現したいこと
VBAで実行するマクロで昇順に取得したい

### 発生している問題・分からないこと
下記サイトを参考に変更前のフォルダ名を一括取得するマクロを作成したのですが、昇順で取得にはどのように内容を変更すれば良いのでしょうか？
お手数ですが、ご教示のほどよろしくお願いいたします。
https://www.higashisalary.com/entry/vba-folder-rename



### 該当のソースコード

```
特になし
```

### 試したこと・調べたこと
- [x] teratailやGoogle等で検索した
- [ ] ソースコードを自分なりに変更した
- [ ] 知人に聞いた
- [ ] その他

##### 上記の詳細・結果
他サイトを検索してみたのですが、実現方法がわからず詰まっております、

### 補足
特になし

VBAのファイル名取得にて、昇順で取得する方法がわかりません

### 実現したいこと
VBAで、指定文字を含むセルを検索し、ヒットした場合は置換して、置換した箇所を赤くするマクロを作成しています。
細かい仕様は下記になります。
・ユーザーからの入力として、検索文字と置換文字をInputBoxで受け取る。
・指定文字を含むセルを検索し、ヒットした場合は置換して、置換した箇所を赤くする。
・置換する際は、一括置換ではなく都度確認メッセージを出す（ctrl+zが使えないための安全策）。
・確認メッセージはvbYesNoCancelで実装。
　　┗「はい」→置換&色変換
　　┗「いいえ」→1つスキップ
　　┗「キャンセル」→マクロを終了
・同一セル内に検索文字（置換対象）が複数ある場合、個別に確認メッセージを出し、置換するかどうかを選択できるようにする。

動作例）　※[]←で囲まれている箇所が赤字
input→検索文字：aaa, 置換文字：zzz
①「はい」を選択
　セル値：aaa,bbb,ccc　期待結果：[zzz],bbb,ccc
②全て「はい」を選択
セル値：aaa,bbb,aaa,ccc　期待結果：[zzz],bbb,[zzz],ccc
③全て「はい」を選択
セル値：bbb,aaa,ccc,aaa　期待結果：bbb,[zzz],ccc,[zzz]
④1回目は「いいえ」、2回目で「はい」を選択
セル値：aaa,bbb,aaa,ccc　期待結果：aaa,bbb,[zzz],ccc
⑤全て「いいえ」を選択
セル値：aaa,bbb,aaa,ccc　期待結果：aaa,bbb,aaa,ccc（置換なし）



### 発生している問題・分からないこと
セル内に複数検索文字が出現する場合の置換や、検索などの実装は想定通りの結果になっていますが、色変換の部分がうまくいきません。
具体的には、動作例②、③のパターンで、2回目の置換時の後の色変換がおかしくなっています。
ソースを見るとわかる通り、loopで「置換→色変換」を回しているのですが、デバッグをしてみると、2回目の置換時に、なぜかセル内の文字の色が変更されているみたいです。
input→検索文字：aaa, 置換文字：zzz
動作例②　セル値：aaa,bbb,aaa,ccc　期待結果：[zzz],bbb,[zzz],ccc　実際の結果：[zzz,bbb,zzz,ccc]
動作例③　セル値：bbb,aaa,ccc,aaa　期待結果：bbb,[zzz],ccc,[zzz]　実際の結果：bbb,zzz,ccc,[zzz]


こちら、置換時になぜセル内の文字の色が勝手に変更されてしまうのでしょうか？
解決策を提示していただけると助かります。
（chatGPTにも聞いてみましたが、解決しませんでした。）
また、VBAは職場を本格的に学び始めたのが去年の冬ごろからなので、書き方がかなり冗長かもしれません。
その点についてもご指摘いただきたいです。
よろしくお願いいたします。



### 該当のソースコード

```
' 置換しなかったセル
Dim noReplaceCell As Range

' 指定文字を置換して指定箇所に色を付ける
Sub ReplaceAndColoraaa()
    Dim searchWord As String
    Dim replaceWord As String
    Dim rStart As Range
    Dim rNext As Range
    Set noReplaceCell = Nothing

    ' 検索文字
    ' searchWord = InputBox("検索文字")
    searchWord = "aaa"
    ' 置換文字
    ' replaceWord = InputBox("置換文字")
    replaceWord = "zzz"


    ' 検索してrangeオブジェクトを取得
    Set rStart = ActiveSheet.Cells.Find(searchWord, lookat:=xlPart, MatchCase:=False, MatchByte:=False)

    ' セルが見つからなかった場合は終了
    If rStart Is Nothing Then
        MsgBox "見つかりません"
        Exit Sub
    End If

    ' 次の検索の初期Rangeオブジェクトに設定
    Set rNext = rStart

    ' 色付けマクロを呼び出し
    Call replaceAndColorSet(rStart, searchWord, replaceWord)
    ' //次を検索
    Do
        Set rNext = Cells.FindNext(After:=rNext)
        ' 検索不一致時はループを抜ける
        If rNext Is Nothing Then
            MsgBox "最後まで検索しました"
            Exit Do
        End If

        ' 最初に検索されたセルが再検索された場合もループを抜ける
        If Not noReplaceCell Is Nothing Then
            If rNext.Address = noReplaceCell.Address Then
                MsgBox "最後まで検索しました"
                Exit Do
            End If
        End If

        ' 色付けマクロを呼び出し
        Call replaceAndColorSet(rNext, searchWord, replaceWord)
    Loop
End Sub


' セル内の指定文字を置換して色付け （Rangeオブジェクト,検索文字,置換文字,色付け文字）
Sub replaceAndColorSet(rStart As Range, searchWord As String, replaceWord As String)
    Dim iStart As Integer
    Dim wordStartPosition As Integer
    Dim wordEndPosition As Integer
    Dim cnt As Integer: cnt = 1


    ' セル内の検索開始位置
    iStart = 1
    ' 変更色
    colorRGB = RGB(255, 0, 0)
    ' 検索文字の終了位置（検索文字数）
    wordEndPosition = Len(searchWord)


    ' 文字色変更
    ' 同一セル内で検索文字が複数回出現する可能性を考慮して繰り返す
    Do
        ' セル内の検索文字の出現位置を取得
        wordStartPosition = InStr(iStart, rStart, searchWord)
        ' 見つからなかったら抜ける
        If wordStartPosition = 0 Then
            Exit Do
        End If

        ' 置換確認 (Noを選択した場合は1つスキップ)
        Range(rStart.Address).Select
        Range(rStart.Address).Characters(wordStartPosition, wordEndPosition).Font.Underline = True
        response = MsgBox(cnt & "つ目の文字を置換しますか？", vbYesNoCancel + vbQuestion, "置換の確認")
        Range(rStart.Address).Characters(wordStartPosition, wordEndPosition).Font.Underline = False

        ' Yesが選択された場合置換して色を付ける
        If response = vbYes Then
            rStart.Value = WorksheetFunction.Replace(rStart, wordStartPosition, wordEndPosition, replaceWord)
            ActiveCell.Characters(Start:=wordStartPosition, length:=wordEndPosition).Font.Color = colorRGB

            ' Noが選択された場合はそのセルをキープ
        ElseIf response = vbNo And noReplaceCell Is Nothing Then
            Set noReplaceCell = rStart

            ' キャンセルが選択された場合はマクロを終了
        ElseIf response = vbCancel Then
            End
        End If
        
        ' 次の検索開始位置を今の検索の終了位置にずらす
        iStart = wordStartPosition + wordEndPosition
        cnt = cnt + 1
    Loop
End Sub
```

### 試したこと・調べたこと
- [x] teratailやGoogle等で検索した
- [x] ソースコードを自分なりに変更した
- [ ] 知人に聞いた
- [ ] その他

##### 上記の詳細・結果
結果は変わりませんでした。

### 補足
特になし

VBAで置換→置換した箇所の色変更を行いたい

### 実現したいこと

エクセルで特定の文字列が入力（プルダウンで選択）されてた時に指定のセルを罫線機能で斜線を表示したい


### 前提

エクセルには入力と「印刷」と「名前」の付けた２つのシートがあります。
「入力」シートの"H7～H36"に「A」「B」「C」「AB」「BC」と5つの文字列をプルダウンリストで設定してあります。
この"入力!H7"にプルダウンで「AB」もしくは「B」が入力された場合に「印刷」シートの"D5""E5""F5""G5"のセルに斜線が表示れるようにしたいです。
また"入力!H8"に「AB」「B」を入力すると今度は「印刷」シートの"D56""E56""F56""G56"に斜線を表示、"入力!H8"に"D107""E107""F107""G107"に罫線といった処理をしたいです。


### 発生している問題・エラーメッセージ

現在は名前の定義で「A」「B」「C」「AB」「BC」それぞれの名前を付けたセルに斜線を引いて、INDIRECT関数を使い「印刷」シートに罫線の画像を表示する方法でごまかしているのですが、動作が極端に遅いため、マクロやVBAを使って表示できないかと思い、質問させていただきました。
### 補足情報（FW/ツールのバージョンなど）

Microsoft　365
Windows 10


エクセルで特定の文字列が入力（プルダウンで選択）されてた時に指定のセルを罫線機能で斜線を表示したい

AccessのVBAからExcelを開いて指定行を固定する操作をしたいです。

```ACCESS
   Dim ExcelApp As Object
   Dim ExcelBook As Object

   Set ExcelApp = CreateObject("excel.application")
   ExcelApp.Visible = True
   Set ExcelBook = ExcelApp.Workbooks.Open(StrFile)

 ExcelBook.Worksheets("Sheet1").Activate
   range("C2").Select
   ActiveWindow.FreezePanes = True
   ExcelBook.Save
   ExcelBook.Close
   ExcelApp.Quit
   Set ExcelBook = Nothing
   Set ExcelApp = Nothing
```
（関係ないコードは省きました）

「range("C2").Select」の行でエラーが起こっており、要するにRangeがうまくセレクトできないという意味だと思います。
このエラーでググって試行錯誤しましたがどうにもよくわかりませんでした。
実行すると表題のエラーが出るときと出ないときがあり、解決方法が見いだせない状況です。

よろしくお願いします。