Len(strName2) – 1) & "и"
Case Else
dhDative = dhDative & strName2
End Select
End If
dhDative = dhDative & " "
End If
' Склонение отчества в дательный падеж
If Len(strName3) > 0 Then
If fMan The
dhDative = dhDative & strName3 & "у"
Else
dhDative = dhDative & Mid(strName3, 1, Len(strName3)
– 1) & "е"
End If
End If
End Function
Function dhGetName(strString As String, intNum As Integer)
' Функция возвращает слово с номером intNum во входной строке _
strString
Dim strTemp As String
Dim intWord As Integer
Dim intSpace As Integer
' Удаление пробелов по краям строки
strTemp = Trim(strString)
' Просмотр строки (до слова с нужным номером)
For intWord = 1 To intNum – 1
' Поиск следующего пробела
intSpace = InStr(strTemp, " ")
If intSpace = 0 Then
' Строка закончилась
intSpace = Len(strTemp)
End If
' Строка strTemp теперь начинается со слова с номером
intWord
strTemp = Trim(Right(strTemp, Len(strTemp) – intSpace))
Next intWord
' Выделение нужного слова (по пробелу после него)
intSpace = InStr(strTemp, " ")
If intSpace = 0 Then
intSpace = Len(strTemp)
End If
dhGetName = Trim(Left(strTemp, intSpace))
End Function
Чтобы ФИО отобразились в родительном падеже, следует установить курсор в ячейку с этими ФИО и запустить макрос PossessiveCase; в дательном падеже – макрос DativeCase (после написания кода эти макросы будут доступны в окне выбора макросов).
Внимание!
Для реализации трюка необходимо соблюдать условие – ячейка должна содержать не менее трех слов. В противном случае операция выполнена не будет.
Следует учитывать, что в ячейке сначала должна следовать фамилия, за ней – имя, и затем – отчество.
Данный макрос не всегда способен корректно обрабатывать сложные имена и фамилии.
Получение информации об используемом принтере
С помощью небольшого макроса можно вывести на экран информацию об используемом принтере. Код макроса записывается в стандартном модуле редактора VBA и выглядит следующим образом (листинг 3.83).
' Объявление API-функции
Declare Function GetProfileStringA Lib «kernel32» _
(ByVal lpAppName As String, ByVal lpKeyName As String, _
ByVal lpDefault As String, ByVal lpReturnedString As _
String, ByVal nSize As Long) As Long
Sub Принтер()
Dim strFullInfo As String * 255 ' Буфер для API-функции
Dim strInfo As String ' Строка с полной информацией
Dim strPrinter As String ' Название принтера
Dim strDriver As String ' Драйвер принтера
Dim strPort As String ' Порт принтера
Dim strMessage As String
Dim intPrinterEndPos As Integer
Dim intDriverEndPos As Integer
' Заполнение буфера пробелами
strFullInfo = Space(255)
' Получение полной информации о принтере
Call GetProfileStringA(«Windows», «Device», "", strFullInfo,
254)
' Удаление лишних символов из конца возвращенной строки
' Строка strInfo имеет формат <имя_принтера>,<драйвер>,<-
порт>:
strInfo = Trim(strFullInfo)
' Поиск запятых в строке (окончаний названий принтера и драйвера)
intPrinterEndPos = Application.Find(",", strInfo, 1)
intDriverEndPos = Application.Find(",", strInfo,
intPrinterEndPos + 1)
' Определение названия принтера
strPrinter = Left(strInfo, intPrinterEndPos – 1)