Добавляйте динамические комментарии в ячейки Excel через VBA

Question

Я пытаюсь использовать комментарии, чтобы показать текущую дату выполнения задачи через макрос VBA. Мое текущее решение выглядит так:

Sub AddDueDates()
Dim strPrefix As String
  strPrefix = ""
  With Range("Target")
If .Comment Is Nothing Then
   .AddComment
End If
.Comment.Visible = True
.Comment.Shape.TextFrame.AutoSize = True
  End With

 With Range("Target").Comment
.Text strPrefix & Range("Source").Text 
End With
End Sub

Я прекрасно понимаю, что это, скорее всего, небрежный код, но я только начинаю снова.

Решение пока работает нормально для одной ячейки. Я назвал ячейки "Target" и "Source" заранее вместо использования ссылок на ячейки, таких как "B12". Теперь я хочу расширить это на несколько ячеек, в зависимости от выбранного мной диапазона (например, A1:A6).

Выборка, куда будут добавлены комментарии, будет соответствовать диапазону такого же размера на другом рабочем листе.

Я чувствую, что цикл будет полезен, но не знаю, с чего начать.

Картинка ниже может проиллюстрировать то, что я хочу сделать. Источник заполнен динамическими датами, которые я хочу добавить в свои комментарии

https://i.stack.imgur.com/EsfEa.jpg

заранее спасибо

Answer 1

Это должно помочь вам начать. Это работает с вашим образцом фотографии, но потребует настройки, если источником комментариев является другой рабочий лист.

Sub AddDates()
Dim targetRng As Range, commentSrcRng As Range
Dim strPrefix As String ' why this variable? You never seem to use it

Set targetRng = Application.InputBox("Please select the target range.  This is the range that will have comments added to each cell", Type:=8)
Set commentSrcRng = targetRng.Offset(0, 3) ' from the screenshot. Will have to tweak if this is a different worksheet.

Dim cel As Range
Dim i As Long
i = 1
For Each cel In targetRng
    If cel.Comment Is Nothing Then
        cel.AddComment
    End If
    cel.Comment.Visible = True
    cel.Comment.Shape.TextFrame.AutoSize = True
    cel.Comment.Text strPrefix & commentSrcRng.Cells(i)
    i = i + 1
Next cel

End Sub