Отображение текста «задом наперед»

Листинг 2.71. Преобразование текста в обратном порядке

Function dhReverseText(strText As String) As String

Dim i As Integer

' Переписываем символы из входной строки в выходную _

в обратном порядке

For i = Len(strText) To 1 Step -1

dhReverseText = dhReverseText & Mid(strText, i, 1)

Next i

End Function

Sub ReverseText()

Dim strText As String

' Ввод строки посредством стандартного окна ввода

strText = InputBox("Введите текст:")

' Реверсия строки и вывод результата

MsgBox dhReverseText(strText), , strText

End Sub

Англоязычный текст — заглавными буквами

Листинг 2.70. Английский текст — в верхнем регистре

Function dhFormatEnglish(strText As String) As String

Dim i As Integer

Dim strCurChar As String * 1

' Анализируется каждый символ строки strText. Каждый символ _

латинского алфавита преобразуется в верхний регистр

For i = 1 To Len(strText)

strCurChar = Mid(strText, i, 1)

' Код латинских строчных символов лежит в пределах _

от 97 до 122

If Asc(strCurChar) >= 97 And Asc(strCurChar) <= 122 Then

' Переводим символ в верхний регистр

dhFormatEnglish = dhFormatEnglish & UCase(strCurChar)

Else

' Просто добавляем символ в выходную строку

dhFormatEnglish = dhFormatEnglish & strCurChar

End If

Next i

End Function

Запуск таблицы символов из Excel

Листинг 3.106. Вызов таблицы символов

Sub ShowSymbolTable()

On Error Resume Next

' Запуск Charmap.exe - таблицы символов

Shell "Charmap.exe", vbNormalFocus

If Err <> 0 Then

MsgBox "Невозможно запустить таблицу символов.", vbCritical

End If

End Sub

Листинг 3.107. Таблица символов

' Декларация API-функций:

' для открытия процесса

Declare Function OpenProcess Lib "kernel32" _

(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _

ByVal dwProcessId As Long) As Long

' для получения кода завершения процесса

Declare Function GetExitCodeProcess Lib "kernel32" _

(ByVal hProcess As Long, lpExitCode As Long) As Long

' для закрытия процесса

Declare Function CloseHandle Lib "kernel32" _

(hProcess) As Long

Sub ShowSymbolTable1()

Dim lProcessID As Long

Dim hProcess As Long

Dim lExitCode As Long

On Error Resume Next

' Запуск таблицы символов (Charman.exe). Функция возвращает _

идентификатор созданного процесса

lProcessID = Shell("Charmap.exe", 1)

If Err <> 0 Then

MsgBox "Нельзя запустить Charman.exe", vbCritical, "Ошибка"

Exit Sub

End If

' Открытие процесса по идентификатору (lProcessID). Функция _

возвращает дескриптор процесса (handle)

hProcess = OpenProcess(&H400, False, lProcessID)

' Ждем, пока процесс завершится, для этого периодически _

получаем код завершения процесса (пока Charman.exe исполняется, _

функция GetExitCodeProcess возвращает &H103)

Do

GetExitCodeProcess hProcess, lExitCode

DoEvents

Loop While lExitCode = &H103

' Закрытие процесса

CloseHandle (hProcess)

' Вывод на экран информационного сообщения

MsgBox "Charmap.exe завершает свою работу"

End Sub

Листинг 3.64. Формат «два знака после запятой»

Sub ChangeNumberFormat()

Selection.NumberFormat = "0.00"

End Sub

Листинг 3.65. Использование разделителя по разрядам

Sub ThreeNullSepatator()

Selection.NumberFormat = "#,##"

End Sub

Листинг 3.66. Изменение формата

Sub ChangeNumerFormatEx()

Selection.NumberFormat = "#,##0.00"

End Sub

Листинг 3.67. Помещение последнего символа над строкой

Sub LastCharUp()

' Изменение расположения последнего символа ячейки

With ActiveCell.Characters(Start:=Len(Selection), Length:=1).Font

.Superscript = True

End With

End Sub

Листинг 3.68. Нестандартная рамка

Sub ChangeSelGrid()

' Оформление границ выделения

' Левая граница

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

' Правая граница

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

' Верхняя граница

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

' Нижняя граница

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

' Изменение сетки внутри выделения

' Вертикальные линии сетки

With Selection.Borders(xlInsideVertical)

.LineStyle = xlContinuous

.Weight = xlHairline

.ColorIndex = xlAutomatic

End With

' Горизонтальные линии сетки

With Selection.Borders(xlInsideHorizontal)

.LineStyle = xlContinuous

.Weight = xlHairline

.ColorIndex = xlAutomatic

End With

End Sub