Готовые макросы в vba excel, Миронов Глава Макросы 9
![]()
|
Создание панели со списком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 |