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

[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]