简体   繁体   中英

Reuse UserForm VBA Code for Multiple Date Pickers in Same Worksheet

I'm wondering how to reuse the VBA code that I have to create multiple Calendar date pickers on the same worksheet that will input to different cells. I have tried changing the name of the .frm file and re-importing it to simply change the cell reference output, but Excel rejects this every time and says the name is already in use. I'm closely following this example .

Bonus points if you know code for how to hide the clickable image until the cell with the date is selected.

Here is the code that I am working with so far in frmCalendar:

Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
   On Error Resume Next
   Dim cell As Object
   For Each cell In Range("C18")
      cell.Value = DateClicked
   Next cell
   Unload Me
End Sub

Private Sub UserForm_Initialize()
   If IsDate(ActiveCell.Value) Then
      Me.MonthView1.Value = Range("C18")
   End If
End Sub

...and my code for Module1:

Sub Sample()
    frmCalendar.Show
End Sub

So basically, I have one calendar that unloads into C18. However, I would like to have up to 10 calendar buttons in my worksheet that have different output cells so they can all have different dates.

Here is an example where the calendar button outputs to C18. It has been assigned the Macro "Sample"

在此处输入图片说明

So how can I reuse my code for multiple calendar buttons? Bonus if there is code to hide the calendar buttons until the cell is selected.

You can store the selected cell when the form opens and use that when you close it.

Dim cell As Range 'selected cell when launched

Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
   On Error Resume Next
   cell.Value = DateClicked
   Unload Me
End Sub

Private Sub UserForm_Initialize()
   Set cell = Selection.Cells(1)
   If IsDate(cell.Value) Then
      Me.MonthView1.Value = cell.Value
   End If
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM