Главная страница
Навигация по странице:

  • Листинг 3.107.

  • Листинг 3.64.

  • Листинг 3.66.

  • Листинг 3.68.

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


    Скачать 1.35 Mb.
    НазваниеГотовые макросы в vba excel, Миронов Глава Макросы 9
    Дата23.01.2019
    Размер1.35 Mb.
    Формат файлаdoc
    Имя файлаГотовые макросы в VBA Excel, Миронов.doc
    ТипДокументы
    #64865
    страница35 из 47
    1   ...   31   32   33   34   35   36   37   38   ...   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
    1   ...   31   32   33   34   35   36   37   38   ...   47


    написать администратору сайта