Mousedown event on MultiPage Userform

sspatriots

Well-known Member
Joined
Nov 22, 2011
Messages
572
Office Version
  1. 365
Platform
  1. Windows
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.

VBA Code:
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
 
This is from the separate "mDatePickerX" module that is also used...

VBA Code:
'+------------------------------------------------------------+
'| 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

Public sDate As Date
Public ctrlName_SetDate As String
Public FormName_SetDate As String
Public ActiveUF As String
Public ActiveCtr1 As String
Public ActiveCtr2 As String
Public Const DatePickerX_DateFormat = "d/m/yyyy"
'Public Const DatePickerX_DateFormat = "m/d/yyyy"

'-------------------COLOR CONTROL
  
   'color apply sample
   'DatePickerX_Back = RGB(Red,Green,Blue)
   'DatePickerX_Back = &H404040
   'DatePickerX_Back = vbBlack
   'Calendar
   Public Const DatePickerX_Back = &H404040
   Public Const DatePickerX_Font = &HC0C0C0
   Public Const DatePickerX_Title_Font = &H80FF80
  
   'normal control
   Public Const Color_Dates_Back = &HC0C0C0
   Public Const Color_Dates_Font = vbBlack
  
   'current date
   Public Const Color_CDate_Backcolor = &HC0C0FF
   Public Const Color_CDate_Font = 1
  
   'on hover
   Public Const Color_HoverColor_Back = &HE0E0E0
   Public Const Color_HoverColor_Font = 1 'NOT USED
  
   'dates falling outside the month
   Public Const Color_ODates_Font = &H808080 'vbGreen
'-------------------
Sub setDate()
Dim tempUFX As Object
'Dim tempUFX As Object

Dim ufr As Object
For Each ufr In UserForms
If ufr.Name = FormName_SetDate Then
      Set tempUFX = ufr
  Exit For
End If
Next ufr

If Not tempUFX Is Nothing Then
   'Set tempUFX = UserForms(FormName_SetDate)
   tempUFX.Controls(ctrlName_SetDate).Value = sDate
   tempUFX.Controls(ctrlName_SetDate).SetFocus
End If
Unload PopDatePickerX

End Sub

'Function setDate(ctrlName As String)
'ctrlName_SetDate = ctrlName: PopDatePickerX.Show
'End Function

Function GetDate() '(ctrlname As String)
'   Dim k As control
'
'
'   ctrlName_SetDate = MAINFR.mp_1(MAINFR.mp_1.Pages).ActiveControl.Name
'   'ctrlName_SetDate = Me.ActiveControl.Name
'
'   Set k = Me.Controls(ctrlName_SetDate)
'   Me.eCalFr.Left = k.Left + k.Width + 2
'   Me.eCalFr.Top = (k.Top + k.Height) - k.Height
'   Me.eCalFr.Visible = True
'
'   If Me.Height < (k.Top + Me.eCalFr.Height) Then
'         Me.eCalFr.Left = (k.Left + k.Width) + 2
'         Me.eCalFr.Top = (k.Top - Me.eCalFr.Height) + k.Height
'   End If
'
'   Set k = Nothing
End Function

Function tempUF() As Object
Dim ufr As Object
For Each ufr In UserForms
If ufr.Name = ActiveUF Then
      Set tempUF = ufr
  Exit For
End If
Next ufr
End Function
Function eCalCtrlRESET()
Dim tempUFXj As Object
Set tempUFXj = tempUF
Dim ctl As control

For Each ctl In tempUFXj.Controls
If ctl.Tag = "daysbg" Or ctl.Tag = "days" Then
   If CDate(ctl.ControlTipText) <> Date Then
      ctl.BackColor = Color_Dates_Back
   Else
      ctl.BackColor = Color_CDate_Backcolor
   End If
End If
Next ctl
Set tempUFXj = Nothing

End Function

Function dhLastDayInMonth(Optional dtmDate As Date = 0) As Date
If dtmDate = 0 Then
dtmDate = Date
End If
dhLastDayInMonth = DateSerial(Year(dtmDate), Month(dtmDate) + 1, 0)
End Function
Sub Button1_Click()

'demoFr.Show

End Sub


This is from the separate "cDatePickerX" Class Module that is also used...

VBA Code:
'+------------------------------------------------------------+
'| 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      |
'+------------------------------------------------------------+

Public WithEvents aMenu As MSForms.Label

Private Sub aMenu_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If aMenu.Name = ActiveCtr1 Or aMenu.Name = ActiveCtr2 Then Exit Sub
eCalCtrlRESET

Dim tempUFXi As Object
Set tempUFXi = tempUF

If InStr(1, aMenu.Name, "day") > 0 Then
      tempUFXi.Controls(Replace(aMenu.Name, "day", "s")).BackColor = Color_HoverColor_Back
      ActiveCtr1 = aMenu.Name
      ActiveCtr2 = Replace(aMenu.Name, "day", "s")
Else
      aMenu.BackColor = Color_HoverColor_Back
      ActiveCtr2 = aMenu.Name
      ActiveCtr1 = Replace(aMenu.Name, "s", "day")
End If
Set tempUFXi = Nothing
End Sub
Private Sub aMenu_Click()
   sDate = aMenu.ControlTipText
   setDate
End Sub


The next two lines are a sample from my "Populate_Job_Status_PM_Form" code that tends to interfere with letting the pop-up Datepicker from overwriting those textboxs when I try calling the "Populate_Job_Status_PM_Form" code from the userform initialize event code.

VBA Code:
            .txtGR1ESTCOMPLDate.Text = tb.ListColumns("Group 1 EST Completion Date").DataBodyRange.Cells(i).Value
            .txtGroup1ShipDate.Text = tb.ListColumns("Group 1 Ship Date to Jobsite").DataBodyRange.Cells(i).Value
 
Last edited:
Upvote 0

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Well after stepping through this code a bunch of times since yesterday, I figured out that I could move the code that is called to populate my UserForm from within the initialize event to shape button on the worksheet that has the line to launch the UserForm (below) ". That is, I call the populate code from the worksheet button after the form is launched.

VBA Code:
Job_Status_PM.Show
 
Upvote 0
Solution

Forum statistics

Threads
1,215,053
Messages
6,122,888
Members
449,097
Latest member
dbomb1414

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top