Здравствуйте, уважаемые Екселисты!!! Помогите, пожалуйста, сделать Всплывающую подсказку, в которой будут отражаться ФИО ( столбец В) и даты, выделенные красным цветом (используем столбец G J N R U). Благодарю заранее!!!!!
Здравствуйте, уважаемые Екселисты!!! Помогите, пожалуйста, сделать Всплывающую подсказку, в которой будут отражаться ФИО ( столбец В) и даты, выделенные красным цветом (используем столбец G J N R U). Благодарю заранее!!!!!ekut
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("G:G,J:J,N:N,R:R,U:U")) Is Nothing Then If Target(1).DisplayFormat.Interior.ColorIndex <> xlNone Then MsgBox Cells(Target.Row, 2).MergeArea(1).Value End If End If End Sub
[/vba]
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("G:G,J:J,N:N,R:R,U:U")) Is Nothing Then If Target(1).DisplayFormat.Interior.ColorIndex <> xlNone Then MsgBox Cells(Target.Row, 2).MergeArea(1).Value End If End If End Sub
Уважаемые Екселисты, спасибо огромное! Видимо не правильно обозначила задачу! При открытии файла у меня уже всплывает подсказка! Но она у меня не учитывает соседние столбцы. Мне бы ее откорректировать!
Уважаемые Екселисты, спасибо огромное! Видимо не правильно обозначила задачу! При открытии файла у меня уже всплывает подсказка! Но она у меня не учитывает соседние столбцы. Мне бы ее откорректировать!ekut
[color=black][l]Private Sub Workbook_Open() 'Всплывающая подсказка Dim sh As Worksheet ', FIO$, Dim Dat As Date, lrow&, i&, s$ Set sh = ThisWorkbook.Worksheets("График инструктажа") Dim DateBegin As Date Dim DateEnd As Date DateBegin = DateSerial(Year(Date), Month(Date), 1) 'первый день текущего месяца DateEnd = DateSerial(Year(Date), Month(Date) + 1, 1) - 1 'последний день текущего месяца ' Dat = Date + 30 With sh lrow = .Cells(.Rows.Count, "A").End(xlUp).Row For i = 4 To lrow If .Cells(i, 2).Value <> "" Then If .Cells(i, 7).Value >= DateBegin And .Cells(i, 7).Value <= DateEnd Then s = s & Chr(10) & .Cells(i, 2).Value & vbTab & vbTab & vbTab & vbTab & .Cells(i, 7).Value End If End If Next i End With UserForm1.Show 0 UserForm1.Label1.Caption = s UserForm1.ScrollHeight = UserForm1.Label1.Height + 20 UserForm1.Height = Application.Min(UserForm1.Label1.Height + 40, 500) 'MsgBox s End Sub
[/l][/color]
[/vba]
Макрос [vba]
Код
[color=black][l]Private Sub Workbook_Open() 'Всплывающая подсказка Dim sh As Worksheet ', FIO$, Dim Dat As Date, lrow&, i&, s$ Set sh = ThisWorkbook.Worksheets("График инструктажа") Dim DateBegin As Date Dim DateEnd As Date DateBegin = DateSerial(Year(Date), Month(Date), 1) 'первый день текущего месяца DateEnd = DateSerial(Year(Date), Month(Date) + 1, 1) - 1 'последний день текущего месяца ' Dat = Date + 30 With sh lrow = .Cells(.Rows.Count, "A").End(xlUp).Row For i = 4 To lrow If .Cells(i, 2).Value <> "" Then If .Cells(i, 7).Value >= DateBegin And .Cells(i, 7).Value <= DateEnd Then s = s & Chr(10) & .Cells(i, 2).Value & vbTab & vbTab & vbTab & vbTab & .Cells(i, 7).Value End If End If Next i End With UserForm1.Show 0 UserForm1.Label1.Caption = s UserForm1.ScrollHeight = UserForm1.Label1.Height + 20 UserForm1.Height = Application.Min(UserForm1.Label1.Height + 40, 500) 'MsgBox s End Sub
Nikita, здравствуйте!!! Спасибо большое за ответ! Но в Вашем варианте есть небольшие погрешности: в подсказке формируются только значения за этот месяц, а просроченных нет. И еще Вы ушли от моей всплывающей подсказки при включении!! Ваша срабатывает при переключении листов, а всплывающая подсказка моя не работает ( на мой взгляд это удобнее) Спасибо заранее.
Nikita, здравствуйте!!! Спасибо большое за ответ! Но в Вашем варианте есть небольшие погрешности: в подсказке формируются только значения за этот месяц, а просроченных нет. И еще Вы ушли от моей всплывающей подсказки при включении!! Ваша срабатывает при переключении листов, а всплывающая подсказка моя не работает ( на мой взгляд это удобнее) Спасибо заранее.ekut
ekut, добрый день. Пришлось заменить заливку просроченных на желтую, сделать цикл по избранным столбцам и заменить макрос книги при открытии.
ekut, добрый день. Пришлось заменить заливку просроченных на желтую, сделать цикл по избранным столбцам и заменить макрос книги при открытии.NikitaDvorets