交互式Excel日历

Question

我是编程界的超级新人，我真的不知道自己在做什么。

我想使我的Excel日历具有交互性。我的意思是，当我单击某天时，我希望它带我到一个新的框/屏幕/单元格，在其中可以看到一个日程安排，而不是默认的月度安排。

这可能吗？如果是这样，我应该从哪里开始？我知道我可以将每个单元格超链接到另一个页面上的另一个单元格，但这将需要很长时间。必须有一种方法可以自动执行此操作？我不需要您确切地告诉我该怎么做，我只需要一个人来帮助我指出正确的方向。

我需要学习什么？

Answer 1

您可以链接单元格，以便当用户单击它时，通常切换要更改的单元格，它会触发一个事件。这是一些代码，当由ozgrid.com上的“ iwrk4dedpr”发布所需的单元格时，将触发事件。至于实际的代码，您将输入以将用户带到一个包含所有日间事件的新工作表中，那么您明确要求我不要告诉您答案。玩得开心/学习！

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Do something if Cell(1,1) or Range("A1") has been selected
if target.row = 1 and target.column = 1 then
' your code in here
end if

End Sub

Answer 2

您可以尝试：

Option Explicit
    Dim ThisDay As Date
    Dim ThisYear, ThisMth As Date
    Dim CreateCal As Boolean
    Dim i As Integer

Private Sub HelpLabel_Click()

End Sub

Private Sub UserForm_Initialize()
    Application.EnableEvents = False
    'starts the form on todays date
    ThisDay = Date
    ThisMth = Format(ThisDay, "mm")
    ThisYear = Format(ThisDay, "yyyy")
    For i = 1 To 12
        CB_Mth.AddItem Format(DateSerial(Year(Date), Month(Date) + i, 0), "mmmm")
Next
    CB_Mth.ListIndex = Format(Date, "mm") - Format(Date, "mm")
For i = -20 To 50
    If i = 1 Then CB_Yr.AddItem Format((ThisDay), "yyyy") Else            CB_Yr.AddItem _
        Format((DateAdd("yyyy", (i - 1), ThisDay)), "yyyy")
    Next
    CB_Yr.ListIndex = 21
    'Builds the calendar with todays date
    CalendarFrm.Width = CalendarFrm.Width
    CreateCal = True
    Call Build_Calendar
    Application.EnableEvents = True
End Sub
Private Sub CB_Mth_Change()
    'rebuilds the calendar when the month is changed by the user
    Build_Calendar
End Sub
Private Sub CB_Yr_Change()
    'rebuilds the calendar when the year is changed by the user
    Build_Calendar
End Sub
Private Sub Build_Calendar()
    'the routine that actually builds the calendar each time
    If CreateCal = True Then
    CalendarFrm.Caption = " " & CB_Mth.Value & " " & CB_Yr.Value
    'sets the focus for the todays date button
    CommandButton1.SetFocus
    For i = 1 To 42
    If i < Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value)) Then
        Controls("D" & (i)).Caption = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
            ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d")
        Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
            ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy")
    ElseIf i >= Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value)) Then
        Controls("D" & (i)).Caption = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) _
            & "/1/" & (CB_Yr.Value))), ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d")
        Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
            ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy")
        End If
        If Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
    ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "mmmm") = ((CB_Mth.Value)) Then
        If Controls("D" & (i)).BackColor <> &H80000016 Then Controls("D" & (i)).BackColor = &H80000018  '&H80000010
        Controls("D" & (i)).Font.Bold = True
    If Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
        ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy") = Format(ThisDay, "m/d/yy") Then Controls("D" & (i)).SetFocus
        Else
            If Controls("D" & (i)).BackColor <> &H80000016 Then Controls("D" & (i)).BackColor = &H8000000F
        Controls("D" & (i)).Font.Bold = False
        End If
    Next
    End If
End Sub
Private Sub D1_Click()
    'this sub and the ones following represent the buttons for days on the form
    'retrieves the current value of the individual controltiptext and
    'places it in the active cell
    ActiveCell.Value = D1.ControlTipText
    Unload Me
    'after unload you can call a different userform to continue data entry
    'uncomment this line and add a userform named UserForm2
    'Userform2.Show

End Sub
Private Sub D2_Click()
    ActiveCell.Value = D2.ControlTipText
    Unload Me

End Sub
Private Sub D3_Click()
    ActiveCell.Value = D3.ControlTipText
    Unload Me

End Sub
Private Sub D4_Click()
    ActiveCell.Value = D4.ControlTipText
    Unload Me

End Sub
Private Sub D5_Click()
    ActiveCell.Value = D5.ControlTipText
    Unload Me

End Sub
Private Sub D6_Click()
    ActiveCell.Value = D6.ControlTipText
    Unload Me

End Sub
Private Sub D7_Click()
    ActiveCell.Value = D7.ControlTipText
    Unload Me

End Sub
Private Sub D8_Click()
    ActiveCell.Value = D8.ControlTipText
    Unload Me

End Sub
Private Sub D9_Click()
    ActiveCell.Value = D9.ControlTipText
    Unload Me

End Sub
Private Sub D10_Click()
    ActiveCell.Value = D10.ControlTipText
    Unload Me

End Sub
Private Sub D11_Click()
    ActiveCell.Value = D11.ControlTipText
    Unload Me

End Sub
Private Sub D12_Click()
    ActiveCell.Value = D12.ControlTipText
    Unload Me

End Sub
Private Sub D13_Click()
    ActiveCell.Value = D13.ControlTipText
    Unload Me

End Sub
Private Sub D14_Click()
    ActiveCell.Value = D14.ControlTipText
    Unload Me

End Sub
Private Sub D15_Click()
    ActiveCell.Value = D15.ControlTipText
    Unload Me

End Sub
Private Sub D16_Click()
    ActiveCell.Value = D16.ControlTipText
    Unload Me

End Sub
Private Sub D17_Click()
    ActiveCell.Value = D17.ControlTipText
    Unload Me

End Sub
Private Sub D18_Click()
    ActiveCell.Value = D18.ControlTipText
    Unload Me

End Sub
Private Sub D19_Click()
    ActiveCell.Value = D19.ControlTipText
    Unload Me

End Sub
Private Sub D20_Click()
    ActiveCell.Value = D20.ControlTipText
    Unload Me

End Sub
Private Sub D21_Click()
    ActiveCell.Value = D21.ControlTipText
    Unload Me

End Sub
Private Sub D22_Click()
    ActiveCell.Value = D22.ControlTipText
    Unload Me

End Sub
Private Sub D23_Click()
    ActiveCell.Value = D23.ControlTipText
    Unload Me

End Sub
Private Sub D24_Click()
    ActiveCell.Value = D24.ControlTipText
    Unload Me

End Sub
Private Sub D25_Click()
    ActiveCell.Value = D25.ControlTipText
    Unload Me

End Sub
Private Sub D26_Click()
    ActiveCell.Value = D26.ControlTipText
    Unload Me

End Sub
Private Sub D27_Click()
    ActiveCell.Value = D27.ControlTipText
    Unload Me

End Sub
Private Sub D28_Click()
    ActiveCell.Value = D28.ControlTipText
    Unload Me

End Sub
Private Sub D29_Click()
    ActiveCell.Value = D29.ControlTipText
    Unload Me

End Sub
Private Sub D30_Click()
    ActiveCell.Value = D30.ControlTipText
    Unload Me

End Sub
Private Sub D31_Click()
    ActiveCell.Value = D31.ControlTipText
    Unload Me

End Sub
Private Sub D32_Click()
    ActiveCell.Value = D32.ControlTipText
    Unload Me

End Sub
Private Sub D33_Click()
    ActiveCell.Value = D33.ControlTipText
    Unload Me

End Sub
Private Sub D34_Click()
    ActiveCell.Value = D34.ControlTipText
    Unload Me

End Sub
Private Sub D35_Click()
    ActiveCell.Value = D35.ControlTipText
    Unload Me

End Sub
Private Sub D36_Click()
    ActiveCell.Value = D36.ControlTipText
    Unload Me

End Sub
Private Sub D37_Click()
    ActiveCell.Value = D37.ControlTipText
    Unload Me

End Sub
Private Sub D38_Click()
    ActiveCell.Value = D38.ControlTipText
    Unload Me

End Sub
Private Sub D39_Click()
    ActiveCell.Value = D39.ControlTipText
    Unload Me

End Sub
Private Sub D40_Click()
    ActiveCell.Value = D40.ControlTipText
    Unload Me

End Sub
Private Sub D41_Click()
    ActiveCell.Value = D41.ControlTipText
    Unload Me

End Sub
Private Sub D42_Click()
    ActiveCell.Value = D42.ControlTipText
    Unload Me

End Sub