Готовые макросы в vba excel, Миронов Глава Макросы 9

• Название: Готовые макросы в vba excel, Миронов Глава Макросы 9
• Дата: 06.02.2018
• Размер: 1.35 Mb.
• Имя файла: 33980_7d1642e70814394f108d07a8a2edd23e.doc
• Тип: Документы; #35930
• страница: 35 из 47

Запуск таблицы символов из 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.'>Листинг 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

глава информация о пользователе, компьютере, принтере и т.д.

Получить имя пользователя

Логин юзера получить просто:

Dim UserName As String

UserName = CreateObject("WScript.Network").UserName

А как отслеживать - вариатнов много.

Я, например, просто не выполняю макрос, если логин не тот:

If ThisWorkbook.Sheets("Rules").Range("Admin").Find(CreateObject("WScript.Network").UserName, _

LookAt:=xlWhole, LookIn:=xlValues) Is Nothing Then Exit Sub

[ответить с цитированием]

Drony

14.12.2007, 10:55

Спасибо, за ответ.

Я тоже нашел эту заветную строку

MsgBox "Имя пользователя : " & CreateObject("WScript.Network").UserNam

CreateObject("WScript.Network").UserName вместо Application.UserName