Scroll hor. to a given day

.DayView.ShowDays(ActualDate, ActualDate + X)
.Populate

Option Explicit

Private Const mclngViewableDays As Long = 4   ' Days to show on-screen at once
Private Const mclngScrollableDays As Long = 10  ' Allowable days to scroll around DayView

Private mlngScrollDirection As Long

Private Sub CalendarControl1_KeyDown(KeyCode As Integer, Shift As Integer)
   ' To move the scrollbar on right/left arrow keys at edge of view
   Select Case KeyCode
   Case vbKeyRight
      ' Right arrow key
      If Me.ScrollBar1.Value < Me.ScrollBar1.Max Then
         ' There are hidden future dates
         If Fix(Me.CalendarControl1.DayView.Selection.End) = Fix(Me.CalendarControl1.DayView.Days(VisibleViewDays).Date) Then
            ' We are at the right-most visible date
            ' So scroll right
            mlngScrollDirection = 1 ' Right
            Me.ScrollBar1.Value = Me.ScrollBar1.Value + 1
         End If
      End If
   Case vbKeyLeft
      ' Left arrow key
      If Me.ScrollBar1.Value > Me.ScrollBar1.Min Then
         ' There are hidden past dates
         If Fix(Me.CalendarControl1.DayView.Selection.Begin) = Fix(Me.CalendarControl1.DayView.Days(0).Date) Then
            ' We are at the left-most visible date
            ' so scroll left
            mlngScrollDirection = -1   ' Left
            Me.ScrollBar1.Value = Me.ScrollBar1.Value - 1
         End If
      End If
   End Select
End Sub

Private Sub CalendarControl1_ViewChanged()
   ' Reset the selected position after scrolling in the KeyDown event
   ' because KeyUp pushes the selection an extra day left/right
   Dim datStart As Date
   
   With Me.CalendarControl1.DayView
      datStart = .Selection.Begin - mlngScrollDirection
      
      On Error Resume Next
      If Fix(datStart) >= Fix(.Days(0).Date) And Fix(datStart) <= Fix(.Days(VisibleViewDays).Date) Then
         If Err.Number = 0 Then
            .Selection.Begin = datStart
            .Selection.End = .Selection.Begin + (.TimeScale / 60 / 24)  ' add 1 timescale unit to the end selection
         End If
      End If
   End With
End Sub

Private Sub Form_Load()
   With Me.CalendarControl1
      .ViewType = xtpCalendarDayView
      .DayView.EnableHScroll False  ' Don't let the user scroll horizontally using the keyboard
   End With
   
   Me.ScrollBar1.Max = (mclngScrollableDays - 1) \ mclngViewableDays
   ScrollBar1_Scroll
End Sub

Private Function VisibleViewDays() As Long
   Dim lngViewableDays As Long
   
   If Me.ScrollBar1.Value < Me.ScrollBar1.Max Then
      lngViewableDays = mclngViewableDays - 1
   Else
      lngViewableDays = mclngScrollableDays Mod mclngViewableDays - 1
      If lngViewableDays < 0 Then
         lngViewableDays = mclngViewableDays - 1
      End If
   End If
   
   VisibleViewDays = lngViewableDays
End Function

Private Sub ScrollBar1_Change()
   ScrollBar1_Scroll
End Sub

Private Sub ScrollBar1_Scroll()
   Dim datStart As Date
   
   datStart = Now + (mclngViewableDays * Me.ScrollBar1.Value)
   With Me.CalendarControl1.DayView
      .ShowDays datStart, datStart + VisibleViewDays
   End With
End Sub