Индивидуальные очистные сооружения: К классу индивидуальных очистных сооружений относят сооружения, пропускная способность которых...
Типы сооружений для обработки осадков: Септиками называются сооружения, в которых одновременно происходят осветление сточной жидкости...
Топ:
Оценка эффективности инструментов коммуникационной политики: Внешние коммуникации - обмен информацией между организацией и её внешней средой...
История развития методов оптимизации: теорема Куна-Таккера, метод Лагранжа, роль выпуклости в оптимизации...
Отражение на счетах бухгалтерского учета процесса приобретения: Процесс заготовления представляет систему экономических событий, включающих приобретение организацией у поставщиков сырья...
Интересное:
Влияние предпринимательской среды на эффективное функционирование предприятия: Предпринимательская среда – это совокупность внешних и внутренних факторов, оказывающих влияние на функционирование фирмы...
Что нужно делать при лейкемии: Прежде всего, необходимо выяснить, не страдаете ли вы каким-либо душевным недугом...
Средства для ингаляционного наркоза: Наркоз наступает в результате вдыхания (ингаляции) средств, которое осуществляют или с помощью маски...
Дисциплины:
2021-10-05 | 50 |
5.00
из
|
Заказать работу |
|
|
Sub ShowComments1()
Dim cell As Range
Dim strFirstAddress As String
Dim strComments As String
' Получаем все ячейки выделения, в которых есть комментарий
Set cell = Selection.Find("*", LookIn:=xlComments)
If Not cell Is Nothing Then
' Сохранение адреса первой найденной ячейки _
(для предотвращения зацикливания поиска)
strFirstAddress = cell.Address
Do
' Добавление текста примечания в выходную строку
strComments = strComments & "Комментарий: " & _
cell.Comment.Text & Chr(13)
' Продолжение поиска
Set cell = Selection.FindNext(cell)
Loop While Not cell Is Nothing And _
cell.Address <> strFirstAddress
End If
If strComments <> "" Then
' Отображение окна с текстом примечаний
MsgBox strComments
Else
MsgBox "В выделенной ячейке/ячейках комментариев нет"
End If
End Sub
Перечень примечаний в отдельном списке_1
Sub ListOfComments()
Dim cell As Range
Dim rgCells As Range
Dim intRow As Integer
' Получение всех ячеек с примечаниями
On Error Resume Next
Set rgCells = Selection.SpecialCells(xlComments)
If rgCells Is Nothing Then
' Примечаний нет
Exit Sub
End If
' Проходим по всем ячейкам диапазона
For Each cell In rgCells
' Вывод примечаний в ячейку столбца "C"
intRow = intRow + 1
Cells(intRow, 3) = cell.Comment.Text
Next
End Sub
Перечень примечаний в отдельном списке_2
Sub ListOfComments1()
Dim cell As Range
Dim strFirstAddress As String
Dim intRow As Integer
' Получение всех ячеек выделения, в которых есть примечания
Set cell = Cells.Find("*", LookIn:=xlComments)
If Not cell Is Nothing Then
' Сохранение адреса первой найденной ячейки _
(для предотвращения зацикливания поиска)
strFirstAddress = cell.Address
Do
' Вывод текста в столбец "C"
intRow = intRow + 1
Cells(intRow, 3) = cell.Comment.Text
' Продолжение поиска
Set cell = Cells.FindNext(cell)
Loop While Not cell Is Nothing And _
cell.Address <> strFirstAddress
End If
End Sub
Перечень примечаний в отдельном списке_3
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
Подсчет количества примечаний_1
Sub CountOfComments()
Dim intCommentCount As Integer
' Получение и отображение количества примечаний
intCommentCount = ActiveSheet.Comments.Count
If intCommentCount = 0 Then
MsgBox "Текущая рабочая книга не содержит примечаний.", _
vbInformation
Else
MsgBox "В текущей рабочей книге содержится " & intCommentCount _
& " комментариев.", vbInformation
End If
End Sub
Подсчет количества примечаний_2
' Function IsCommentsPresent
' Возвращает TRUE, если на активном рабочем листе имеется хотя бы
' одна ячейка с комментарием, иначе возвращает FALSE
'
Public Function IsCommentsPresent() As Boolean
IsCommentsPresent = (ActiveSheet.Comments.Count <> 0)
End Function
Подсчет примечаний_3
Sub CountOfComment()
Dim intCommentCount As Integer
' Получение и отображение количества примечаний _
на текущем листе
intCommentCount = ActiveSheet.Comments.Count
If intCommentCount = 0 Then
MsgBox "Примечаний нет"
Else
MsgBox "Примечаний: " & intCommentCount & " шт."
End If
End Sub
|
|
|
Архитектура электронного правительства: Единая архитектура – это методологический подход при создании системы управления государства, который строится...
Поперечные профили набережных и береговой полосы: На городских территориях берегоукрепление проектируют с учетом технических и экономических требований, но особое значение придают эстетическим...
Кормораздатчик мобильный электрифицированный: схема и процесс работы устройства...
Археология об основании Рима: Новые раскопки проясняют и такой острый дискуссионный вопрос, как дата самого возникновения Рима...
© cyberpedia.su 2017-2024 - Не является автором материалов. Исключительное право сохранено за автором текста.
Если вы не хотите, чтобы данный материал был у нас на сайте, перейдите по ссылке: Нарушение авторских прав. Мы поможем в написании вашей работы!