Страницы: 1
RSS
автоматическое добавление примечания со временим
 
Здравствуйте, помогите с макросом.  
Нужно чтобы автоматически добавлялось примечание в котором бы указывалось время изменения значения ячейки.  
Пример: пустая ячейка, примечания нет, вбиваю значение 155 и у ячейки появляется примечание которое скрыто, если навожу на ячейку - всплывает примечание, маленького размера, со временем, допустим 18:34, если нажимаю del, удаляется и значение ячейки и примечание.
 
Пример файла в студию :)
 
вот пример, там изображено то что хотелось бы видеть
 
Макрос не мой (The_Prist(Щербаков Дмитрий)) , но ето Ваш вариант:  
 
Option Explicit  
Private Sub Worksheet_Change(ByVal Target As Range)  
   Dim oComment As Comment  
   On Error Resume Next  
   Set oComment = Target.Comment  
   If oComment Is Nothing Then  
       Target.AddComment Target.Text & " " & Format(Now, "dd.mm.yy HH:MM")  
   Else  
       oComment.Text oComment.Text & Chr(10) & Target.Text & " " & Format(Now, "dd.mm.yy HH:MM")  
   End If  
End Sub  
 
http://www.excel-vba.ru/chto-umeet-excel/zapis-izmenenij-na-liste-v-primechaniya/
 
спасибо большое! а как сделать что бы он отображал только время и размер примечания был маленький?  
Сейчас он добавляет примечание стандартного размера, и в нем указывается вводимое значение, дата, время
 
Динамическое примечание (в зависимости от текста в ячейке):    
http://www.planetaexcel.ru/forum.php?thread_id=25512&page_forum=1&allnum_forum=39  
Удалите в макросе dd.mm.yy
 
{quote}{login=Shaleiko}{date=03.12.2012 10:34}{thema=}{post}Динамическое примечание (в зависимости от текста в ячейке):    
http://www.planetaexcel.ru/forum.php?thread_id=25512&page_forum=1&allnum_forum=39  
Удалите в макросе dd.mm.yy{/post}{/quote}  
по ссылке просмотрел все сообщения, мне там ничего не понятно.  
первым делом удалил dd.mm.yy и вместо "значение ячейки, дата, время" осталось "значение ячейки, время"  
а мне нужно только "время" и в 4 раза уменьшенное примечание, если не в 6
 
если вручную записать макрос по изменению размера примечания, то получится следующее  
{quote}  
Range("B10").Select  
Range("B10").Comment.Text Text:="55 04.12.12 09:06"  
Selection.ShapeRange.ScaleWidth 0.78, msoFalse, msoScaleFromTopLeft  
Selection.ShapeRange.ScaleHeight 0.23, msoFalse, msoScaleFromTopLeft  
{/quote}  
но это не работает в моем макросе.  
 
Нужно чтобы примечание было маленьким, чисто для времени,  
Нужно убрать из примечание само вводимое число  
В условие нужно добавить что это все работает если только вводимое значение ЧИСЛО  
 
помогите пожалуйста, кто знает
 
ой, что то не добавилось. Вот что записывает макрос  
 
Range("B10").Select  
Range("B10").Comment.Text Text:="55 04.12.12 09:06"  
Selection.ShapeRange.ScaleWidth 0.78, msoFalse, msoScaleFromTopLeft  
Selection.ShapeRange.ScaleHeight 0.23, msoFalse, msoScaleFromTopLeft
 
Попробуйте так:  
 
 
Option Explicit  
Private Sub Worksheet_Change(ByVal Target As Range)  
Dim oComment As Comment  
On Error Resume Next  
Set oComment = Target.Comment  
If oComment Is Nothing Then  
With Target.AddComment  
   .Text Format(Now, "HH:MM")  
   .Shape.Height = 12  
   .Shape.Width = 28  
End With  
Else  
With oComment  
   .Text Format(Now, "HH:MM")  
   .Shape.Height = 12  
   .Shape.Width = 28  
End With  
End If  
End Sub  
 
 
Размер подобран на глазок
 
Всем огромное человеческое спасибо)) все идеально  
lanerus, отдельная уважуха
 
последний штрих  
при удалении значения в ячейке - удаляется примечание
 
Попробуйте так.  
Private Sub Worksheet_Change(ByVal Target As Range)  
   Dim oComment As Comment  
   With Target  
       If .Count > 1 Then Exit Sub  
       'на ячейке без коммента, ClearComments не ломается  
       'IsNumber пустую ячейку не воспринимает как  ноль- это есть хорошо )  
       If Not WorksheetFunction.IsNumber(.Value) Then .ClearComments: Exit Sub  
       On Error Resume Next  
       Set oComment = .Comment  
       If oComment Is Nothing Then  
           .AddComment.Text Format(Now, "HH:MM")  
       Else  
           oComment.Text Format(Now, "HH:MM")  
       End If  
       .Comment.Shape.Width = 40  
       .Comment.Shape.Height = 20  
   End With  
End Sub
Страницы: 1
Читают тему
Наверх