Option Explicit
Private col_Terms As Collection
Private bChkSkp As Boolean
'
Private Sub Worksheet_Change(ByVal Target As Range)
If Not bChkSkp Then
If Target = Cells(6, 10) Then
Call sb_col_Terms_Chk(Target)
End If
End If
End Sub
Private Sub sb_col_Terms_Chk(pTgt As Range)
Dim i&, iLB&, iUB&
Dim sRsp$
On Error GoTo ErH
If col_Terms Is Nothing Then Call sb_col_Terms_Ini
sRsp = col_Terms(pTgt.Value)
iLB = 1: iUB = Len(sRsp)
bChkSkp = True
For i = iLB To iUB
pTgt.Offset(0, i).Value = Mid(sRsp, i, 1)
Next
bChkSkp = False
Exit Sub
ErH:
sRsp = col_Terms(CStr(-vbObjectError)): Resume Next
End Sub
Private Sub sb_col_Terms_Ini()
Set col_Terms = New Collection
With col_Terms
.Add "Err!", CStr(-vbObjectError) ' error
.Add "1310", "треугольник"
.Add "2473", "круг"
.Add "1596", "квадрат"
End With
End Sub |
