Вот код, который преобразовывает значение ячейки в соответствие с регистром после ввода
Подправил код, думаю, так правильнее.
В модуль листа:
Код |
---|
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, myArr()
Dim CharVariable As Integer, SpaceVariable As Integer
If Target = "" Then Exit Sub
SpaceVariable = FindLettersAfterSpace(Target)
CharVariable = FindSpaces(Target)
If CharVariable > 1 Or CharVariable = 0 Or SpaceVariable <> 3 _
Or ПроверкаИнициаловНаНаличиеТочки(Target) = False Then
MsgBox "Вводите инициалы через точку!!!"
Target.ClearContents
Exit Sub
End If
ReDim myArr(1 To Len(Target))
For i = 1 To Len(Target)
myArr(i) = Mid(Target, i, 1)
Next
For i = LBound(myArr) To UBound(myArr)
If i = 1 Then myArr(1) = UCase(myArr(1))
If i = UBound(myArr) - 1 Then myArr(UBound(myArr)) = UCase(myArr(UBound(myArr)))
If i = UBound(myArr) - 1 Then myArr(UBound(myArr) - 2) = UCase(myArr(UBound(myArr) - 2))
Next
Target = Join(myArr, "")
End Sub
|
В отдельный модуль функции:
Код |
---|
Function FindSpaces(CharVariable As Range) As Integer
Dim i, myCounter, myVar As String
myCounter = 0
myVar = RTrim(CStr(CharVariable))
For i = 1 To Len(myVar)
If Mid(myVar, i, 1) = " " Then myCounter = myCounter + 1
Next
FindSpaces = myCounter
End Function
Function FindLettersAfterSpace(myRange As Range) As Integer
Dim i, k, myVar As String, Letter As Integer
Letter = 0
myVar = RTrim(CStr(myRange))
For i = 1 To Len(myVar)
If Mid(myVar, i, 1) = " " Then
For k = 1 To Len(Mid(myVar, InStr(1, myVar, " "), Len(myVar)))
Letter = k - 1
Next k
Exit For
End If
Next
FindLettersAfterSpace = Letter
End Function
Function ПроверкаИнициаловНаНаличиеТочки(myRange As Range) As Boolean
Dim i, Letter As Integer
Dim newString As String
newString = Mid(myRange, InStr(1, myRange, " "), Len(myRange))
If Mid(newString, 3, 1) <> "." Then
ПроверкаИнициаловНаНаличиеТочки = False
Else
ПроверкаИнициаловНаНаличиеТочки = True
End If
End Function
|