'If Hour(Now) = 0 Then Med_Chart.lblTimeLine.Left = 270
'If Hour(Now) = 1 Then Med_Chart.lblTimeLine.Left = 288
'If Hour(Now) = 2 Then Med_Chart.lblTimeLine.Left = 306
'If Hour(Now) = 3 Then Med_Chart.lblTimeLine.Left = 324
'If Hour(Now) = 4 Then Med_Chart.lblTimeLine.Left = 342
'If Hour(Now) = 5 Then Med_Chart.lblTimeLine.Left = 360
'If Hour(Now) = 6 Then Med_Chart.lblTimeLine.Left = 378
'If Hour(Now) = 7 Then Med_Chart.lblTimeLine.Left = 396
'If Hour(Now) = 8 Then Med_Chart.lblTimeLine.Left = 414
'If Hour(Now) = 9 Then Med_Chart.lblTimeLine.Left = 0
'If Hour(Now) = 10 Then Med_Chart.lblTimeLine.Left = 18
'If Hour(Now) = 11 Then Med_Chart.lblTimeLine.Left = 36
'If Hour(Now) = 12 Then Med_Chart.lblTimeLine.Left = 54
'If Hour(Now) = 13 Then Med_Chart.lblTimeLine.Left = 72
'If Hour(Now) = 14 Then Med_Chart.lblTimeLine.Left = 90
'If Hour(Now) = 15 Then Med_Chart.lblTimeLine.Left = 108
'If Hour(Now) = 16 Then Med_Chart.lblTimeLine.Left = 126
'If Hour(Now) = 17 Then Med_Chart.lblTimeLine.Left = 144
'If Hour(Now) = 18 Then Med_Chart.lblTimeLine.Left = 162
'If Hour(Now) = 19 Then Med_Chart.lblTimeLine.Left = 180
'If Hour(Now) = 20 Then Med_Chart.lblTimeLine.Left = 198
'If Hour(Now) = 21 Then Med_Chart.lblTimeLine.Left = 216
'If Hour(Now) = 22 Then Med_Chart.lblTimeLine.Left = 234
'If Hour(Now) = 23 Then Med_Chart.lblTimeLine.Left = 252

If Hour(Now) = 0 Then Me.lblTimeLine.Left = 270
......................... и так 24 раза

If Hour(Now) >= 0 And Hour(Now) <= 8 Then
    For j = 0 To 8
    Me.lblTimeLine.Left = 270
        If Hour(Now) = j Then Me.lblTimeLine.Left = Me.lblTimeLine.Left + 18 * j
        Next j
Else
    For y = 0 To 15
    Me.lblTimeLine.Left = 0
        For x = 9 To 23
        If Hour(Now) = x Then Me.lblTimeLine.Left = Me.lblTimeLine.Left + 18 * y
        Next x
    Next y
End If

Private Sub HourReload()
CurrentHour = Hour(Now)
Dim lblHour As Integer
Dim lblname As Control

For Each lblname In ChartFrame 'название рамки объединяющей все лейблы
 If TypeOf lblname Is Label Then
        For i = 0 To 23
        If lblname Like "*i" Then lblHour = i
        Next i
 End If
Next lblname


If lblHour <> CurrentHour Then
   lbl.BackColor = &H80000004
Else
   lbl.BackColor = &HC0E0FF
End If
End Sub  

Sub CreateDisplayPopUpMenu()
    ' Delete the popup menu if it exist.
    Call DeletePopUpMenu

    ' Create the correct menu based on the active worksheet.
    Dim rng As Range, rng2 As Range
    Set rng = ActiveSheet.Range("Area")
    Set rng2 = ActiveSheet.Range("Area2")
    Select Case Range.Name
    Case "area": Call Custom_PopUpMenu_1
    Case "area2": Call Custom_PopUpMenu_2
    Case Else: MsgBox "Sorry no Popup Menu"
    End Select

    ' Show the popup menu.
    On Error Resume Next
    Application.CommandBars(Mname).ShowPopup
    On Error GoTo 0
End Sub