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

  • Листинг 4.1.

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


    Скачать 1.35 Mb.
    НазваниеГотовые макросы в vba excel, Миронов Глава Макросы 9
    Дата06.02.2018
    Размер1.35 Mb.
    Формат файлаdoc
    Имя файла33980_7d1642e70814394f108d07a8a2edd23e.doc
    ТипДокументы
    #35930
    страница32 из 47
    1   ...   28   29   30   31   32   33   34   35   ...   47

    Создание панели со списком


    Sub DeleteCustomContextMenu()

    ' Удаление меню

    On Error Resume Next

    CommandBars("MyContextMenu").Delete

    End Sub

    Sub ShowFormatNumber()

    ' Число

    Application.Dialogs(xlDialogFormatNumber).Show

    End Sub

    Sub ShowFormatAlignment()

    ' Выравнивание

    Application.Dialogs(xlDialogAlignment).Show

    End Sub

    Sub ShowFormatFont()

    ' Шрифт

    Application.Dialogs(xlDialogFormatFont).Show

    End Sub

    Sub ShowFormatBorder()

    ' Граница

    Application.Dialogs(xlDialogBorder).Show

    End Sub

    Sub ShowFormatPatterns()

    ' Вид (Узор)

    Application.Dialogs(xlDialogPatterns).Show

    End Sub

    Sub ShowFormatProtection()

    ' Защита

    Application.Dialogs(xlDialogCellProtection).Show

    End Sub

    Sub CreatePanel()

    Dim i As Integer

    On Error Resume Next

    ' Удаление одноименной панели (если есть)

    CommandBars("Список месяцев").Delete

    On Error GoTo 0

    ' Создание панели "Список месяцев"

    With CommandBars.Add

    .Name = "Список месяцев"

    ' Создание списка месяцев

    With .Controls.Add(Type:=msoControlDropdown)

    ' Настройка (имя, макрос, стиль)

    .Caption = "DateDD"

    .OnAction = "SetMonth"

    .Style = msoButtonAutomatic

    ' Добавление в список названий месяцев

    For i = 1 To 12

    .AddItem Format(DateSerial(1, i, 1), "mmmm")

    Next i

    ' Выделение первого месяца

    .ListIndex = 1

    End With

    ' Показываем созданную панель

    .Visible = True

    End With

    End Sub

    Sub SetMonth()

    ' Перенос названия выделенного месяца в ячейку

    On Error Resume Next

    With CommandBars("Список месяцев").Controls("DateDD")

    ActiveCell.Value = .List(.ListIndex)

    End With

    End Sub

    Мультфильм с помощником в главной роли


    Листинг 4.1. «Танцующий» помощник

    Sub RunAssistantDance()

    Static intAction As Integer

    ' Заставляем помощника выполнять действие (всего 16)

    DoAssistantAction intAction

    intAction = intAction + 1

    If intAction < 16 Then

    ' Следующее действие через 3 секунды

    Application.OnTime Time + TimeValue("00:00:3"), _

    "RunAssistantDance"

    End If

    End Sub

    Sub DoAssistantAction(intAction As Integer)

    Dim astAssistant As Assistant

    Set astAssistant = Application.Assistant

    ' Помещаем помощника в центр активного окна

    astAssistant.Top = Application.ActiveWindow.Top _

    + Application.ActiveWindow.Height / 2

    astAssistant.Left = Application.ActiveWindow.Left _

    + Application.ActiveWindow.Width / 2

    ' Показываем помощника

    astAssistant.On = True

    astAssistant.Visible = True

    ' Показываем заданное параметром intAction действие

    Select Case intAction

    Case 0

    astAssistant.Animation = msoAnimationAppear

    Case 1

    astAssistant.Animation = msoAnimationCheckingSomething

    Case 2

    astAssistant.Animation = msoAnimationBeginSpeaking

    Case 3

    astAssistant.Animation = msoAnimationCharacterSuccessMajor

    Case 4

    astAssistant.Animation = msoAnimationEmptyTrash

    Case 5

    astAssistant.Animation = msoAnimationGestureDown

    Case 5

    astAssistant.Animation = msoAnimationGestureLeft

    Case 6

    astAssistant.Animation = msoAnimationGestureRight

    Case 7

    astAssistant.Animation = msoAnimationGestureUp

    Case 8

    astAssistant.Animation = msoAnimationGetArtsy

    Case 9

    astAssistant.Animation = msoAnimationGetAttentionMajor

    Case 10

    astAssistant.Animation = msoAnimationGetAttentionMinor

    Case 11

    astAssistant.Animation = msoAnimationGetTechy

    Case 12

    astAssistant.Animation = msoAnimationGetWizardy

    Case 13

    astAssistant.Animation = msoAnimationGoodbye

    Case 14

    astAssistant.Animation = msoAnimationGreeting

    Case 15

    astAssistant.Animation = msoAnimationDisappear

    End Select

    End Sub
    1   ...   28   29   30   31   32   33   34   35   ...   47


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