Mousedown event on MultiPage Userform

[sspatriots]

Hi,

I have the code below that pops a "datepicker" calendar open whenever selected and then puts that value in a textbox on my userform. I just noticed today that it no longer works for me since I went to a multipage userform. In fact, if I'm on page 2 of the userform it will just take me back to page 1 of the userform without entering the date in that textbox. Basically, it isn't working at all for any pages in the userform.

Private Sub Image1_Mousedown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ctrlName_SetDate = "txtGR1ESTCOMPLDate": FormName_SetDate = Me.Name: PopDatePickerX.Show
End Sub

Any help on this would be greatly appreciated. Thanks, SS

 

[Domenic]

It looks like your event handler is referencing an image control, not a multipage control. Let's say that your multipage control is named "MultiPage1", the event handler should be...

Private Sub MultiPage1_MouseDown(ByVal Index As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    'your code here
    '
    '
End Sub

Hope this helps!

 

[sspatriots]

The images are little calendar icons that when picked they launch the datepicker calendar and that date is supposed to go back into that textbox on the userform. There are about 17 of them on this one userform. How would I make it work so that the date from the datepicker goes into the respective textbox where the date is going? They all worked great until I switched to the multipage userform, becasue I have a separate code written for each image, numbers 1 through 17 and all have their own textbox to place that calendar date into. Thanks,

 

[sspatriots]

I tried the following just to text out, but at this point not sure if I'm even close.

Private Sub MultiPage1_Mousedown(ByVal Index As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

Dim currentPage As String
currentPage = MultiPage1.SelectedItem.Name

If currentPage = "Page1" Then

    With Me.Image18
        PopDatePickerX.Show
        ctrlName_SetDate = "txtGR1ESTCOMPLDate"
        FormName_SetDate = Me.Name

    End With
    
    With Me.Image19
    
        ctrlName_SetDate = "txtGroup1ShipDate"
        FormName_SetDate = Me.Name
        PopDatePickerX.Show

    End With


End If


End Sub

 

[Domenic]

Sorry, it looks like I misunderstood.

So you're still using image controls for your mousedown events, but now you've moved them within a multipage control, correct? If so, those event handlers should work just the same.

What code are you using in PopDatePickerX to write to your textboxes?

By the way, I'm not sure when I'll be able to get back on the Board, so hopefully others will be able to help in the meantime.

 

[sspatriots]

Honestly, that last attempt was just to try and get it working again. I have a total of 19 mousedown events. Two of which are on the second page of the multipage form. So there are 19 separate mousedown event codes just like the on in the original post that are not working now since I went to a multipage userform, only difference is they are labeled image1 through image 19. Now the only thing it does is open the pop-up calendar. When I select a date from the calendar, the calendar closes and the form doesn't do anything but go back to page 1 of the userform if on page 2 and if on page 1 trying to use 1 of the 17 calendars it appears that nothing changes.

 

[sspatriots]

bump

anyone else here with experience like this?

 

[sspatriots]

I've managed to narrow down the problem now, just don't know how to clear the textbox and let the new date go in that textbox like it did before.

I've added the following line of code to clear the textbox before the mousedown event.

txtGR1ESTCOMPLDate.Text = ""

I can see that it clears the field (if it already has a date in there) and then the pop-up calendar comes up and I can select the date. As soon as I do that the original date comes right back into that field. The original date is coming from a macro called "Populate_Job_Status_PM_Form" that populates the userform which is called from the userform initialize event.

Private Sub Image22_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

txtGR1ESTCOMPLDate.Text = ""

ctrlName_SetDate = "txtGR1ESTCOMPLDate": FormName_SetDate = Me.Name: PopDatePickerX.Show
End Sub

I don't know how to get it to overwrite the selected date over the existing date in that textbox. It won't even overwrite if the textbox was initially blank when the userform is populated. Like I mentioned in my original post, this functionality was working 100% before I went to a multipage userform. I have a feeling that has something to do with this, but have not clue as to how to correct it.

I also can comment out a couple of the lines of code that automatically populate a couple of those textboxes when the userform is initialized. When I do that of course, these same textboxes do not get populated when "Populate_Job_Status_PM_Form" code is called. However, it allows me to use the pop-up calendar for those fields. Weird. Still not solution though

 

[Domenic]

Can you post the code that you are using in PopDatePickerX to populate your textboxes?

 

[sspatriots]

I've narrowed this down to the population of the userform from the code called "Populate_Job_Status_PM_Form". If I take this part out of the userform initialize event and just run it after the form is intialized, I can change the date fields with the datepicker calendar. Ideally, I would like that form populated automatically when opened, but that is what is causing the issue.

'+------------------------------------------------------------+
'| VbaA2z - DatePickerX S-1.0 | 10/18/2020                    |
'| Compatible with 32-Bit and 64-Bit Office                   |
'| Author: L. Pamai (VbaA2z.Team@gmail.com)                   |
'| Visit channel: Youtube.com/VbaA2z                          |
'| More download: VbaA2z.Blogspot.com                         |
'+------------------------------------------------------------+
'| Free for personal and commercial use at your own risk      |
'+------------------------------------------------------------+

Option Explicit

Dim DatePickerX_Ctrls() As cDatePickerX

Private Sub UserForm_Initialize()
DatePickerX_Ini
GetDate
End Sub

Sub PX_hide()

On Error Resume Next
DatePickerX.Visible = False
On Error GoTo 0

End Sub

Function GetDate()
'date picker loader

Dim k As control
With Me.DatePickerX
   .Visible = True
End With
End Function

Function DatePickerX_PrevNext(showNxt As Boolean)
Dim tmpDate As Date, vNewMonthDate As Date
   tmpDate = DateSerial(Me.mem_year.Value, Me.mem_mth.Value, 1)
   If showNxt = True Then
   vNewMonthDate = DateAdd("m", 1, tmpDate)
   Else
   vNewMonthDate = DateAdd("m", -1, tmpDate)
   End If
   Call LoadDates(Month(vNewMonthDate), Year(vNewMonthDate))
End Function

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub eCalNextMonth_Click()
   DatePickerX_PrevNext True
End Sub

Private Sub eCalPrevMonth_Click()
   DatePickerX_PrevNext False
End Sub

Private Sub eCalTitle_Click()
   tbYear.Visible = True
   mthsCB.Visible = True
   mthsCB.Height = 133.9
End Sub

Private Sub eCalToday_Click()
   Call LoadDates(Month(Date), Year(Date))
End Sub

Private Sub mthsCB_Click()

   Me.eCalTitle.Caption = Me.mthsCB.Value & " " & Me.tbYear.Value
   tbYear.Visible = False
   mthsCB.Visible = False
   
   'Call LoadDates(mthnobytext(mthsCB.Value), tbYear.Value)
    Call LoadDates(mthsCB.Column(1), tbYear.Value)
 
End Sub

Private Sub tbYear_Change()
   If Len(tbYear.Value) >= 4 Then
      tbYear.Value = Left(tbYear.Value, 4)
   End If
End Sub

Private Sub tbYear_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   Select Case KeyAscii
      Case 48 To 57
         If Len(tbYear) >= 4 Then
            KeyAscii = 0
         End If
      Case Else
          KeyAscii = 0
   End Select
End Sub


Sub DatePickerX_Ini()
Dim Obj As Object, CtrlPointer As Long
'------------------------------------------------------
Me.tbYear.Value = Year(Date)
'With mthsCB
'   .Clear
'   .AddItem "January"
'   .AddItem "February"
'   .AddItem "March"
'   .AddItem "April"
'   .AddItem "May"
'   .AddItem "June"
'   .AddItem "July"
'   .AddItem "August"
'   .AddItem "September"
'   .AddItem "October"
'   .AddItem "November"
'   .AddItem "December"
mthsCB.ColumnCount = 1

Dim xMonths(1 To 12, 1 To 2) As String
Dim i As Integer, j As Integer

xMonths(1, 1) = Format(DateSerial(2020, 1, 1), "MMMM")
xMonths(2, 1) = Format(DateSerial(2020, 2, 1), "MMMM")
xMonths(3, 1) = Format(DateSerial(2020, 3, 1), "MMMM")
xMonths(4, 1) = Format(DateSerial(2020, 4, 1), "MMMM")
xMonths(5, 1) = Format(DateSerial(2020, 5, 1), "MMMM")
xMonths(6, 1) = Format(DateSerial(2020, 6, 1), "MMMM")
xMonths(7, 1) = Format(DateSerial(2020, 7, 1), "MMMM")
xMonths(8, 1) = Format(DateSerial(2020, 8, 1), "MMMM")
xMonths(9, 1) = Format(DateSerial(2020, 9, 1), "MMMM")
xMonths(10, 1) = Format(DateSerial(2020, 10, 1), "MMMM")
xMonths(11, 1) = Format(DateSerial(2020, 11, 1), "MMMM")
xMonths(12, 1) = Format(DateSerial(2020, 12, 1), "MMMM")

xMonths(1, 2) = 1
xMonths(2, 2) = 2
xMonths(3, 2) = 3
xMonths(4, 2) = 4
xMonths(5, 2) = 5
xMonths(6, 2) = 6
xMonths(7, 2) = 7
xMonths(8, 2) = 8
xMonths(9, 2) = 9
xMonths(10, 2) = 10
xMonths(11, 2) = 11
xMonths(12, 2) = 12

mthsCB.Clear
mthsCB.List = xMonths

'End With
'------------------------------------------------------
Me.DatePickerX.Visible = False
ActiveUF = Me.Name
Call LoadDates(Month(Date), Year(Date))
DatePickerX.BackColor = DatePickerX_Back
Me.eCalTitle.ForeColor = DatePickerX_Title_Font
'------------------------------------------------------
ReDim DatePickerX_Ctrls(1 To Me.Controls.Count)
For Each Obj In Me.Controls
    If TypeName(Obj) = "Label" And (Obj.Tag = "daysbg" Or Obj.Tag = "days") Then
        CtrlPointer = CtrlPointer + 1
        Set DatePickerX_Ctrls(CtrlPointer) = New cDatePickerX
        Set DatePickerX_Ctrls(CtrlPointer).aMenu = Obj
    End If
Next Obj
ReDim Preserve DatePickerX_Ctrls(1 To CtrlPointer)
'------------------------------------------------------
End Sub
Function LoadDates(mth As Byte, yearX As Integer)
Dim nDate As Date, dayNo As String, lDate As Date, mthNo As Byte, yrNo As Byte, kDate As Date, i As Long, dayX As Long
'------------------------------------------------------
nDate = DateSerial(yearX, mth, 1)
dayNo = Weekday(nDate, 0) 'daybyNo(Format(nDate, "DDD"))
lDate = dhLastDayInMonth(nDate)
Me.eCalTitle.Caption = Format(nDate, "MMMM YYYY")

Me.mem_mth = Month(nDate)
Me.mem_year = Year(nDate)

'for non english days. update day header here.
Me.Controls("D" & 1).Caption = "S"
Me.Controls("D" & 2).Caption = "M"
Me.Controls("D" & 3).Caption = "T"
Me.Controls("D" & 4).Caption = "W"
Me.Controls("D" & 5).Caption = "T"
Me.Controls("D" & 6).Caption = "F"
Me.Controls("D" & 7).Caption = "S"

'------------------------------------------------------
dayX = 1

'reset
For i = 1 To 42
   Me.Controls("day" & i).ForeColor = Color_Dates_Font
   dayX = dayX + 1
Next i

dayX = 1

kDate = nDate

For i = dayNo To 42
   
   Me.Controls("day" & i).Caption = Day(kDate) 'CInt(Format(kDate, "DD"))
   
   If kDate <> Date Then
      Me.Controls("s" & i).BackColor = Color_Dates_Back
   Else
      Me.Controls("s" & i).BackColor = Color_CDate_Backcolor
   End If
   
   Me.Controls("day" & i).ForeColor = Color_Dates_Font
   
   Me.Controls("s" & i).ControlTipText = kDate
   Me.Controls("day" & i).ControlTipText = kDate
   
   If kDate > lDate Then
      Me.Controls("day" & i).ForeColor = Color_ODates_Font
   End If
   
   dayX = dayX + 1
   kDate = kDate + 1
   
Next i
'------------------------------------------------------
'prior dates
kDate = nDate
If dayNo > 1 Then
For i = dayNo - 1 To 1 Step -1
   Me.Controls("day" & i).Caption = Day(kDate - 1) 'CInt(Format(kDate - 1, "DD"))
   
   Me.Controls("s" & i).ControlTipText = kDate - 1
   Me.Controls("day" & i).ControlTipText = kDate - 1
   
   Me.Controls("day" & i).ForeColor = Color_ODates_Font
   dayX = dayX + 1
   kDate = kDate - 1
Next i
End If

Dim m_d1 As Byte
m_d1 = Day(nDate)
'------------------------------------------------------
End Function