Возможно, проблема тривиальна, и уже было её решение. Но, к сожалению, через поиск по форуму ничего подходящего не нашел.
Есть диапазон ячеек. В примере - B4:H16. Есть значения, которые вводятся в эти ячейки - "з", "б", "у", "о", "п" и т.п. (всегда одна буква, либо ячейка остается пустой). Можно ли сделать так, чтобы при вводе в ячейку, в рамках этого диапазона, значений "з", "б" или "у", выскакивал меседжбокс с текстом "Введите комментарий" и возможностью ввода текста. И, далее, при вводе текста, он (текст) добавлялся бы в виде примечания к ячейке, где было введено значение (з/б/у)?
Заранее благодарю за внимание и уделенное время.
Здравствуйте, господа!
Возможно, проблема тривиальна, и уже было её решение. Но, к сожалению, через поиск по форуму ничего подходящего не нашел.
Есть диапазон ячеек. В примере - B4:H16. Есть значения, которые вводятся в эти ячейки - "з", "б", "у", "о", "п" и т.п. (всегда одна буква, либо ячейка остается пустой). Можно ли сделать так, чтобы при вводе в ячейку, в рамках этого диапазона, значений "з", "б" или "у", выскакивал меседжбокс с текстом "Введите комментарий" и возможностью ввода текста. И, далее, при вводе текста, он (текст) добавлялся бы в виде примечания к ячейке, где было введено значение (з/б/у)?
Заранее благодарю за внимание и уделенное время.ArkaIIIa
контекстное меню ярлыка листа - "Исходный текст", туда это: [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Intersect(Target, Range("B4:H16")) Is Nothing Then Exit Sub
Dim sComm As String
With Target Select Case .Value Case "з", "б", "у" sComm = InputBox("Введите комментарий:", , "Тру-ля-ля") If Len(sComm) > 0 Then .ClearComments .AddComment sComm End If
End Select End With End Sub
[/vba]
контекстное меню ярлыка листа - "Исходный текст", туда это: [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Intersect(Target, Range("B4:H16")) Is Nothing Then Exit Sub
Dim sComm As String
With Target Select Case .Value Case "з", "б", "у" sComm = InputBox("Введите комментарий:", , "Тру-ля-ля") If Len(sComm) > 0 Then .ClearComments .AddComment sComm End If
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [B4:H16]) Is Nothing Then t = InputBox("ВВедите комментарий") If t <> "" Then With Target .AddComment .Comment.Visible = False .Comment.Text Text:=t End With End If End If End Sub
[/vba]
Вариант Сани лучше Но не пропадать же добру )
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [B4:H16]) Is Nothing Then t = InputBox("ВВедите комментарий") If t <> "" Then With Target .AddComment .Comment.Visible = False .Comment.Text Text:=t End With End If End If End Sub
[/vba]
Вариант Сани лучше Но не пропадать же добру )SkyPro
skypro1111@gmail.com
Сообщение отредактировал SkyPro - Понедельник, 22.09.2014, 13:03
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Len(Target) > 1 Then Exit Sub If Intersect(Target, Range("B4:H16")) Is Nothing Then Exit Sub On Error GoTo A If WorksheetFunction.Find(Target, "збу") Then Target.ClearComments Target.AddComment Text:=InputBox("Введите комментарий") End If A: End Sub
[/vba]
И у меня добро, которому не пропадать же [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Len(Target) > 1 Then Exit Sub If Intersect(Target, Range("B4:H16")) Is Nothing Then Exit Sub On Error GoTo A If WorksheetFunction.Find(Target, "збу") Then Target.ClearComments Target.AddComment Text:=InputBox("Введите комментарий") End If A: End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
Но не пропадать же добру )
