已完成 有偿寻找VBA高手处理一个问题

Bonnie

具体报酬：50元人民币或协商
支付方式：支付宝，微信
联系方式：QQ：1044997
有效期限：2022年03月06日之前。
需求描述：
无法上传附件。不知为何。
附件上传到了百度网盘。请求高手帮忙。。。。
    链接: https://pan.baidu.com/s/1D8Uoh2Jpj11dkXiPZOntLg?pwd=i8f7 提取码: i8f7

（1）系统环境（XP/Win2003/Vista/Win7/WIN10，中文版/英文版，专业版/家庭版/精简版，等）
要实现的功能的描述：现有一个VBA文档。。。C3行有四个按钮。。C4行和C7行为手动输入的数据。。C6行是C4行(请输入车架号)数据转换进制得来的。。C9行是C7行(请输入防盗密码)数据转换进制得来的。
。C6行的数据能随着C3行的按钮点击而变化数据。。。。而C9行的数据无法随之变化。。
。C9行的数据需要点击完C3行的四个按钮中的任何一个后重新在C7行输入一次才变化。。。。

有没有什么办法能像C6行一样。。。
VBA代码如下。

Option Explicit
Private Sub CommandButton6_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    If Button = 2 And Shift = 4 Then
        UserForm22.Show 0
    End If
End Sub
Private Sub Worksheet_Change(ByVal target As Range)
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim dic, keys, i
    Dim a As Boolean
    a = False
    If target.Address = "$C$4:$D$4" Or target.Address = "$C$4" Then
        Sheet1.Unprotect 159790
        If Application.WorksheetFunction.CountA(target) <> 0 Then
            target.Value = UCase(target.Value)
            For i = 1 To Len(target.Value)
                If InStr(".*-/\';/.,=-!@#$%^&*()_+<>?|>< ，。、", Mid(target.Value, i, 1)) > 0 Then
                    a = True
                    Exit For
                End If
            Next
            If Len(target.Value) <> 17 Or LenB(target.Value) <> 34 Or a Then
                'If Range("c4").Value <> "请输入车架号" Then
                    变色 target.Offset(1).MergeArea
                'End If
                Range("$A$5:$B$5").ClearContents
                '播放声音
            Else
                VIN target.Offset(1).MergeArea
                Range("$A$5:$B$5") = 转换ASCLL码(target.Value)
            End If
        Else
            变色 target.Offset(1).MergeArea
            Range("$A$5:$B$5").ClearContents
            Range("$C$6:$D$6").ClearContents
            Range("c4").Value = "请输入车架号"
        End If
        Sheet1.Protect 159790
    End If
    If target.Address = "$C$7:$D$7" Or target.Address = "$C$7" Then
        Sheet1.Unprotect 159790
        防道密码 Range("$c7")
        Sheet1.Protect 159790
    End If
 If CommandButton3.BackColor = vbGreen Or CommandButton4.BackColor = vbGreen Or CommandButton5.BackColor = vbGreen Then
      If Application.WorksheetFunction.CountA(Range("$A$5:$B$5")) <> 0 And Application.WorksheetFunction.CountA(Range("$C$3:$D$3")) <> 0 Then
        Set dic = RangeToDic(Sheet4.Range("a1").CurrentRegion)
        keys = Range("$C$3").Value & ""
        Range("$C$6").Value = "/h:11 /k:4:1003 /b:2EF190" & Range("$A$5") & dic(keys)
      Else
        Range("$C$6:$D$6").Value = ""
      End If
 Else
    If Application.WorksheetFunction.CountA(Range("$A$5:$B$5")) <> 0 And Application.WorksheetFunction.CountA(Range("$C$3:$D$3")) <> 0 Then
        Set dic = RangeToDic(Sheet4.Range("a1").CurrentRegion)
        keys = Range("$C$3").Value & ""
        Range("$C$6").Value = "/p:18 /h:11 /k:4:1003 /E:752 /R:652 /b:2EF190" & Range("$A$5") & dic(keys)
    Else
        Range("$C$6:$D$6").Value = ""
    End If
 End If
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub
Function 转换ASCLL码(n)
    Dim k As Integer
    Dim i As Integer
    Dim s As String
    Dim keys
    Dim dic
    Set dic = RangeToDic(Sheet4.Range("d1").CurrentRegion)
    k = Len(n)
    For i = 1 To k
        keys = Mid(n, i, 1)
        s = s & dic(keys)
    Next
    转换ASCLL码 = s
End Function
Function RangeToDic(rng As Range, Optional keycol = 1, Optional itemcol = 2)
    '2列标准数据写入字典
    Dim dic
    Dim i As Integer
    Set dic = CreateObject("scripting.dictionary")
    For i = 1 To rng.Rows.Count
        If rng.Cells(i, keycol) <> "" Then
            dic(Trim(rng.Cells(i, keycol)) & "") = rng.Cells(i, itemcol)
        End If
    Next
    Set RangeToDic = dic
End Function
Sub 防道密码(target As Range)
    Dim i As Integer
    Dim a As Boolean
    a = False
    If Application.WorksheetFunction.CountA(target.Resize(1, 2)) <> 0 Then
        target.Value = UCase(target.Value)
        For i = 1 To Len(target.Value)
            If InStr(".*-/\';/.,=-!@#$%^&*()_+<>?|>< ，。、", Mid(target.Value, i, 1)) > 0 Then
                a = True
                Exit For
            End If
        Next
     If CommandButton3.BackColor = vbGreen Or CommandButton4.BackColor = vbGreen Or CommandButton5.BackColor = vbGreen Then
        If Len(target.Value) <> 4 Or LenB(target.Value) <> 8 Or InStr(target.Value, "O") > 0 Or InStr(target.Value, "I") > 0 Or a Then
            'If Range("c7").Value <> "请输入防盗密码" Then
                变色 target.Offset(1).MergeArea
            'End If
            '播放声音
            Range("$A$8").Resize(1, 2).ClearContents
            Range("$C$9").Resize(1, 2).ClearContents
        Else
            KEY target.Offset(1).MergeArea
            Range("$A$8") = 转换ASCLL码(target.Value)
            Range("$C$9").Value = "/h:11 /k:4:1003 /b:3101DF06" & Range("$A8")
        End If
     Else
        If Len(target.Value) <> 4 Or LenB(target.Value) <> 8 Or InStr(target.Value, "O") > 0 Or InStr(target.Value, "I") > 0 Or a Then
            'If Range("c7").Value <> "请输入防盗密码" Then
                变色 target.Offset(1).MergeArea
            'End If
            '播放声音
            Range("$A$8").Resize(1, 2).ClearContents
            Range("$C$9").Resize(1, 2).ClearContents
        Else
            KEY target.Offset(1).MergeArea
            Range("$A$8") = 转换ASCLL码(target.Value)
            Range("$C$9").Value = "/p:18 /h:11 /k:4:1003 /E:752 /R:652 /b:31010601" & Range("$A8")
        End If
     End If
    Else
        Range("c7").Value = "请输入防盗密码"
        变色 target.Offset(1).MergeArea
        Range("$A$8").Resize(1, 2).ClearContents
        Range("$C$9").Resize(1, 2).ClearContents
    End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal target As Range)
    Application.EnableEvents = False
    If target.Address(0, 0) Like "??:??" Then
        Sheet1.Unprotect 159790
    Else
        Sheet1.Protect 159790
    End If
    If target.Address = "$H$2:$O$9" Then
        Sheet1.Protect 159790
    End If
    Application.EnableEvents = True
End Sub
Private Sub CommandButton3_Click()
    Sheet1.Unprotect 159790
    Me.CommandButton5.BackColor = &H8000000F
    Me.CommandButton3.BackColor = vbGreen
    Me.CommandButton4.BackColor = &H8000000F
    Me.CommandButton7.BackColor = &H8000000F
    [c3] = CommandButton3.Caption
    Sheet1.Protect 159790
End Sub
Private Sub CommandButton4_Click()
    Sheet1.Unprotect 159790
    Me.CommandButton5.BackColor = &H8000000F
    Me.CommandButton3.BackColor = &H8000000F
    Me.CommandButton4.BackColor = vbGreen
    Me.CommandButton7.BackColor = &H8000000F
    [c3] = CommandButton4.Caption
    Sheet1.Protect 159790
End Sub
Private Sub CommandButton5_Click()
    Sheet1.Unprotect 159790
    Me.CommandButton5.BackColor = vbGreen
    Me.CommandButton3.BackColor = &H8000000F
    Me.CommandButton4.BackColor = &H8000000F
    Me.CommandButton7.BackColor = &H8000000F
    [c3] = CommandButton5.Caption
    Sheet1.Protect 159790
End Sub
Private Sub CommandButton7_Click()
    Sheet1.Unprotect 159790
    Me.CommandButton5.BackColor = &H8000000F
    Me.CommandButton3.BackColor = &H8000000F
    Me.CommandButton4.BackColor = &H8000000F
    Me.CommandButton7.BackColor = vbGreen
    [c3] = CommandButton7.Caption
    Sheet1.Protect 159790
End Sub
复制代码