VBA UserForm チェックボックスで文字列操作を最適化

'文字列終了位置変更および位置スライド用
Private Sub SpinB1_Change()
    Dim s As Long
    Dim d As Long
    d = Val(TxtBox1.Value) - Val(TxtBox0.Value) + 1 '選択文字数
    TxtBox2.Value = d
    If ChkBox1.Value = True Then　'Trueの場合「スライド」する設定
        If SpinB1.Value < d Then
            TxtBox1.Value = d
            SpinB1.Value = d
        Else: TxtBox1.Value = SpinB1.Value
        End If
        TxtBox0.Value = Val(TxtBox1.Value) - d + 1
    Else    'Falseの場合、範囲を増減する設定
        If SpinB1.Value < Val(TxtBox0.Value) Then
            TxtBox1.Value = SpinB1.Value
            '選択範囲が入れ替わってしまう場合
            If SpinB1.Value = 0 Then
                TxtBox0.Value = 0
            Else: TxtBox0.Value = 1
            End If
        Else
            '「0」から再び増加する場合
            If Val(TxtBox0.Value) = 0 Then
                TxtBox0.Value = SpinB1.Value
            End If
            TxtBox1.Value = SpinB1.Value
        End If
        d = Val(TxtBox1.Value) - Val(TxtBox0.Value) + 1
        If SpinB1.Value = 0 Then
            TxtBox2.Value = 0
        Else
            TxtBox2.Value = d
        End If
    End If
    If Val(TxtBox0.Value) < 0 Then TxtBox0.Value = 0
    If Val(TxtBox1.Value) < 0 Then TxtBox1.Value = 0
    With txtPW
        .SetFocus   'フォーカスを受ける
        If Val(TxtBox0.Value) = 0 Then
            .SelStart = Val(TxtBox0.Value)
        Else: .SelStart = Val(TxtBox0.Value) - 1
        End If
        .SelLength = Val(TxtBox1.Value) - .SelStart
        'ここから記号チェック
        If OptB2.Value = True Then
                '範囲内に「記号」がある場合は何もしない
                s = chkType(txtPW.Value) '「記号」チェック関数へ
                If s >= Val(TxtBox0.Value) And _
                    s <= Val(TxtBox1.Value) Then
                    Exit Sub
                Else
                    MsgBox "選択範囲に「記号」が存在しなくなります！" _
                        & vbCrLf & "設定を変更してください！", _
                        vbOKOnly + vbCritical
                End If
        End If
    End With
End Sub

'BASE64形式文字列内の記号がある位置を返す関数
Function chkType(str As String) As Long
    Dim i As Long
    Dim a As String
    For i = 1 To Len(str)
        a = Mid(str, i, 1)
        'BASE64形式の文字列はアルファベットと数字以外
        If Not (a Like "[A-Za-z0-9]") Then
            chkType = i
            Exit Function
        End If
    Next
End Function

'テキスト部の文字列を重複せずにItemに登録
Private Sub Cmb2_Change()
    Dim i As Long       'ループカウンター用
    Dim c As Long       'HIT列保存用
    Dim flg As Long     '重複チェック用フラグ
    Dim strSet As String, strC() As String
    Dim eRow As Long
    Dim rng1 As Range, rng2 As Range
    strSet = Cmb2.Text
    If strSet = "" Then Exit Sub
    With Worksheets("設定値")
        eRow = .Cells(Rows.Count, 2).End(xlUp).Row
        Set rng1 = Range(Cells(1, 1), .Cells(eRow, 1)) '1列目
        Set rng2 = Range(Cells(1, 2), .Cells(eRow, 2)) '2列目
        '同じItemが存在するかチェックする
        For i = 2 To rng2.Count
            If rng2(i).Value = strSet Then
                flg = flg + 1
                ReDim Preserve strC(flg) As String
                strC(flg) = rng1(i).Value & "/" & i
            End If
        Next
        '「名称」が重複している場合「分類」を選択させる
        Dim re As Long
        If flg > 1 Then
            For i = 1 To flg
                strSet = Left(strC(i), InStr(strC(i), "/") - 1)
                re = MsgBox("複数の分類が設定されています！" & vbCrLf _
                    & "対象の分類を選択してください！" & vbCrLf & vbCrLf _
                    & "分類は【" & strSet & "】" & "でよろしいすか？", _
                    vbExclamation + vbYesNo, "分類選択")
                If re = vbYes Then Exit For
            Next
            If re = vbNo Then Exit Sub
            flg = i
        End If
        c = Mid(strC(flg), InStr(strC(flg), "/") + 1, Len(strC(flg)))
        Cmb1.Text = .Cells(c, 1).Value
        Cmb3.Text = .Cells(c, 3).Value
        Cmb4.Text = .Cells(c, 4).Value
        If .Cells(c, 5).Value <> "" Then _
            TxtBox0.Value = .Cells(c, 5).Value
        If .Cells(c, 6).Value <> "" Then
            TxtBox1.Value = .Cells(c, 6).Value
        End If
        TxtBox2.Value = Val(TxtBox1.Value) - Val(TxtBox0.Value) + 1
        'PW文字列設定へ
        Call cmdPW_Click
        'Option設定を反映させる
        Select Case .Cells(c, 7).Value
            Case OptB1.Caption: OptB1.Value = True '任意
            Case OptB2.Caption: OptB2.Value = True '指定
            Case OptB3.Caption: OptB3.Value = True '禁止
        End Select
    End With
    SpinB1.Value = TxtBox1.Value 'スピンボタンの値を初期化
End Sub

'禁止チェック
Private Sub OptB3_Click()
    Dim s As String
    With txtPW
        'txtPWの「記号」を削除して表示する
        s = Replace(.Text, "+", "")
        s = Replace(s, "/", "")
        s = Replace(s, "=", "")
        .Text = s
        'txtPWの選択表示を再設定
        .SetFocus   '再度フォーカスをあてる
        .SelStart = TxtBox0.Value - 1
        .SelLength = .SelStart + Val(TxtBox2.Value)
        'スピンボタンの最大値を修正
        SpinB1.Value = TxtBox1.Value
        SpinB1.Max = Len(s)
    End With
End Sub