![]() Главная страница Случайная страница КАТЕГОРИИ: АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника |
Несколько трюков в одном примере
Листинг 3.39. Операции с примечаниями Sub CountOfComments() Dim intCommentCount As Integer ' Получение и отображение количества примечаний intCommentCount = ActiveSheet.Comments.Count If intCommentCount = 0 Then MsgBox " Текущая рабочая книга не содержит примечаний.", _ vbInformation Else MsgBox " В текущей рабочей книге содержится " & intCommentCount _ & " комментариев.", vbInformation End If End Sub
Sub SelectComments() ' Выделение всех ячеек с примечаниями Cells.SpecialCells(xlCellTypeComments).Select End Sub
Sub ShowComments() ' Отображение всех примечаний If Application.DisplayCommentIndicator = xlCommentAndIndicator Then Application.DisplayCommentIndicator = xlCommentIndicatorOnly Else Application.DisplayCommentIndicator = xlCommentAndIndicator End If End Sub
Sub ListOfCommentsToFile() Dim rgCells As Range ' Ячейки с примечаниями Dim intDefListCount As Integer ' Используется для временного _ хранения количества листов в книге по умолчанию Dim strSheet As String ' Имя анализируемого листа Dim strWorkBook As String ' Имя книги с анализируемым листом Dim intRow As Integer Dim cell As Range
' Получение ячеек с примечаниями On Error Resume Next Set rgCells = ActiveSheet.Cells.SpecialCells(xlComments) On Error GoTo 0 ' Если примечаний нет, то можно не продолжать If rgCells Is Nothing Then MsgBox " Текущая рабочая книга не содержит примечаний.", _ vbInformation Exit Sub End If
' Сохранение имен анализируемого листа и книги strSheet = ActiveSheet.Name strWorkBook = ActiveWorkbook.Name
' Создание отдельной книги с одним листом _ для отображения результатов intDefListCount = Application.SheetsInNewWorkbook Application.SheetsInNewWorkbook = 1 Workbooks.Add Application.SheetsInNewWorkbook = intDefListCount ActiveWorkbook.Windows(1).Caption = " Comments for " & strSheet & _ " in " & strWorkBook
' Создание списка примечаний Cells(1, 1) = " Адрес" Cells(1, 2) = " Содержимое" Cells(1, 3) = " Комментарий" Range(Cells(1, 1), Cells(1, 3)).Font.Bold = True intRow = 2 ' Данные начинаются со второй строки For Each cell In rgCells Cells(intRow, 1) = cell.Address(rowabsolute: =False, _ columnabsolute: =False) Cells(intRow, 2) = " " & cell.Formula Cells(intRow, 3) = cell.comment.Text intRow = intRow + 1 Next End Sub
Sub ChangeCommentColor() ' Автоматическое изменение цвета комментариев Dim comment As comment For Each comment In ActiveSheet.Comments ' Задаем случайные цвета заливки и шрифта комментариев comment.Shape.Fill.ForeColor.SchemeColor = Int((80) * Rnd + 1) comment.Shape.TextFrame.Characters.Font.ColorIndex = Int((56 _ ) * Rnd + 1) Next End Sub
|