Готовые макросы в vba excel, Миронов Глава Макросы 9
![]()
|
Добавление примечаний в диапазон по условиюSub CreateComments() Dim cell As Range ' Производим поиск по всем ячейкам диапазона и добавляем примечания _ ко всем ячейкам, содержащим слово "Выручка" For Each cell In Range("B1:B100") If cell.Value Like "*Выручка*" Then cell.ClearComments cell.AddComment "Неучтенная наличка" End If Next End Sub Перенос комментария в ячейку и обратноSub Комментарий_в_ячейку_в_диапазоне() 'переносит комментарий в ячейку Dim i As Long Dim c As Range, cc As Range Dim iCommment As Comments Application.DisplayCommentIndicator = xlCommentIndicatorOnly Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set cc = Selection 'если выделили 1 ячейку, то выход If cc.Rows.Count = 1 And cc.Columns.Count = 1 Then MsgBox "Выделено слишком мало ячеек!", , "Ошибка" End End If Set cc = Selection.SpecialCells(xlCellTypeVisible) For Each c In cc If Not c.Comment Is Nothing Then c.Value = c.Comment.Text 'c.ClearComments 'если надо удалить комментарий i = i + 1 End If End If Next Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True MsgBox "Перенесено " & i & " комментариев!" Exit Sub End Sub Перенос значений из ячейки в комментарий_1Sub Добавить_комментарий_в_диапазоне() 'копирует значение ячейки в комментарий в видемом диапазоне Dim c As Range, cc As Range Dim i As Long On Error GoTo ErrorHandler Application.DisplayCommentIndicator = xlCommentIndicatorOnly Set cc = Selection 'если выделили 1 ячейку, то выход If cc.Rows.Count = 1 And cc.Columns.Count = 1 Then MsgBox "Выделено слишком мало ячеек!", , "Ошибка" End End If Set cc = Selection.SpecialCells(xlCellTypeVisible) For Each c In cc If c.Value <> Empty Then c.AddComment CStr(c.Value) i = i + 1 End If Next MsgBox "Добавлено " & i & " комментарий!" Exit Sub End Sub Перенос значений из ячейки в комментарий_2Sub Comment_in_Cell() Dim c As Range Dim r As Range If ActiveSheet.Comments.Count = 0 Then MsgBox "Без комментариев!": Exit Sub Set sh = ActiveSheet Set shnew = Sheets.Add sh.Select Set r = Range(Cells(1, 1), Cells(Cells.Find("*", [A1], xlComments, , xlByRows, _ xlPrevious).Row, Cells.Find("*", [A1], xlComments, , xlColumns, _ xlPrevious).Column)) For Each c In r If Not c.Comment Is Nothing Then shnew.Range(c.Address) = c.Comment.Text End If Next End Sub Глава . Пользовательские вкладки на лентеДополнение панели инструментовSub AddCustomCommandBar() ' Добавление кнопки на панель инструментов With Application.CommandBars(3).Controls.Add(Type:=msoControlButton) .FaceId = 42 ' Значок Word .Caption = "Кнопка" .OnAction = "Макрос" End With End Sub Добавление кнопки на панель инструментовSub AddCustomButton() ' Добавление кнопки на панель инструментов With Application.Toolbars(1).ToolbarButtons.Add(button:=222) .Name = "Кнопка" .OnAction = "Макрос" End With End Sub Панель с одной кнопкойSub CreateCustomControlBar() ' Создание панели инструментов With Application.CommandBars.Add(Name:="Панель", Temporary:=True) ' Создание и настройка кнопки With .Controls.Add(Type:=msoControlButton) .Style = msoButtonIconAndCaption .FaceId = 66 .Caption = "Просто кнопка" End With ' Покажем панель .Visible = True End With End Sub Панель с двумя кнопкамиSub CreateCustomControlBar() ' Создание панели инструментов With Application.CommandBars.Add(Name:="Панель", Temporary:=True, _ Position:=msoBarLeft) ' Создание и настройка первой кнопки With .Controls.Add(Type:=msoControlButton) .Style = msoButtonWrapCaption .Caption = "Просто кнопка" End With ' Создание и настройка второй кнопки With .Controls.Add(Type:=msoControlButton) .Style = msoButtonIconAndWrapCaption .Caption = "Кнопка" .FaceId = 225 End With ' Покажем панель .Visible = True End With End Sub |