ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

¦U¦ì¤j¤j¡A½Ð°ÝUserFormªí³æ¦p¦óŪ¨ú¤lªí³æ

¦U¦ì¤j¤j¡A½Ð°ÝUserFormªí³æ¦p¦óŪ¨ú¤lªí³æ

¦U¦ì¤j¤j¡A½Ð¦U¦ìÀ°¦£¦buserform1ÂI¿ïtextbox1¤¤¦Û°Ê¼u¥XUserForm2

¿ï¾Ü¤é´Á«á¦Û°Ê¶ñ¦^textbox1

test001.rar (24.51 KB)

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-12-27 11:10 ½s¿è

¦A¦¸ÁÂÁ ­ã´£³¡ªL«e½ú«ü¾É

«ö¶sµù¸Ñ:


«ö«ö¶s«áµ²ªG:


Private Sub Build_Calendar()
Dim Y0 As Date, Y1 As Date, Y2 As Date, Y3 As Date, Fb, Fc, Fu, Fs, Bc
'¡ô«Å§iÅܼÆ:(Y0,Y1,Y2,Y3)¬O¤é´ÁÅܼÆ,¨ä¥L¬O³q¥Î«¬ÅܼÆ
Y1 = DateSerial(CB_Yr, CB_Mth.ListIndex + 1, 1)
'¡ô¥OY1³o¤é´ÁÅܼƬO DateSerial(yyyy,m,d) ²Õ¦X¥X·Q­nªº¦è¤¸¦~/¤ë/¤é(yyyy/m/d)(¤ëªì¤é)
'CB_Mth.ListIndex + 1 ªº·N«ä¥Î²qªº:CB_Mth¤U©Ô¦¡²M³æ¤è¶ôÅã¥Ü­È©Ò¦bªº²M³æ¯Á¤Þ¦ì¸m,¦Ó¨ä²M³æ¯Á¤Þ¬O0~11 (²qªº!)


'DateSerial ¨ç¼Æ
'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/dateserial-function

'ListIndex ÄÝ©Ê,ÃѧO ListBox ©Î ComboBox ¤¤¥Ø«e¿ï¨úªº±M®×¡C
'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/listindex-property

Y2 = DateAdd("m", 1, Y1) - 1
'¡ô¥OY2³o¤é´ÁÅܼƬO DateAdd(m´«ºâªº¤Ñ¼Æ:28¡B29¡B30©Î31,1m,Y1ÅܼƤé´Á¬°°ò·Ç¤é)(yyyy/m/d)(¤ë§À¤é)
'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/dateadd-function
Y0 = Y1 - (Y1 - 1) Mod 7
'¡ô¥OY0¬O [Y1ÅܼÆ(¤ëªì¤é) -  Y1ÅܼÆ(¤ëªì¤é)ªº«e¤@¤Ñ °£7 ªº¾l¼Æ(¥ý°£¥X¾l¼Æ¦A¬Û´î)] ªº¤é´Á
'³o¬O­nºâ¤ë¾äªº²Ä¤@¤Ñ
For i = 1 To 42
'¡ô³]¶¶°j°é!i±q1¨ì42
    Y3 = Y0 + i - 1
    '¡ô¥OY3³o¤é´ÁÅܼƬO ¤ë¾äªº²Ä¤@¤Ñ+i°j°é¼Æ -1
    Fb = True
    '¡ô¥OFb³o³q¥ÎÅܼƬO ¥¬ªL­È True
    Fs = 12
    '¡ô¥OFs³o³q¥ÎÅܼƬO 12
    Fu = False
    '¡ô¥OFu³o³q¥ÎÅܼƬO ¥¬ªL­È False
    Fc = &H80000012
    '¡ô¥OFu³o³q¥ÎÅܼƬO Windows «ö¶s¤Wªº¤å¦rÃC¦â¥N¸¹
    '¨t²ÎÃC¦â±`¶q
    '·j´M VBA ¨t²ÎÃC¦â±`¶q

    Bc = &H8000000F
    '¡ô¥OBc¬O BackColor Äݩʪº­È³]©w¬° Windows ªí³æ¤¤ªº¹w³]­È
    'https://learn.microsoft.com/zh-tw/office/vba/api/visio.viewer.backcolor
    If Y3 Mod 7 < 2 Then Fc = &HFF
    '¡ô¦pªGY3¤é´ÁÅܼư£7«áªº¾l¼Æ <2 ,´N¥OFu³o³q¥ÎÅܼƬO 255
    'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/hex-function

    If Y3 < Y1 Or Y3 > Y2 Then
    '¡ô¦pªGY3¤é´ÁÅÜ¼Æ < Y1¤é´ÁÅܼÆ(¤ëªì¤é) ©Î Y3¤é´ÁÅÜ¼Æ >Y1¤é´ÁÅܼÆ(¤ë§À¤é),
       Fb = False
       '¡ô¥OFb³o³q¥ÎÅܼƬO ¥¬ªL­È False
       Fu = True
       '¡ô¥OFu³o³q¥ÎÅܼƬO ¥¬ªL­È True
       Fs = 11
       '¡ô¥OFs³o³q¥ÎÅܼƬO 11
       Bc = &H808080
       '¡ô¥OBc³o³q¥ÎÅܼƬO Windows ¨t²ÎÃC¦â¥N¸¹(¦Ç¦âªº)
    End If
    With UserForm2("D" & i)
    '¡ô¥H¤U¬OÃö©óUserForm2 42­Ó¤é´Á«ö¶sªºµ{§Ç
         .Font.Bold = Fb '²ÊÅé
         .Font.Size = Fs '¦rÅé¤j¤p
         .Font.Underline = Fu '«D¥»¤ë-¥[©³½u
         .ForeColor = Fc '¦rÅéÃC¦â
         .BackColor = Bc '­I´ºÃC¦â
         .Caption = Day(Y3)
         '¡ô¥O«ö¶sÅã¥Ü¤å¦r¬O Day()Â^¨úY3¤é´ÁÅÜ¼Æ ¤é¼Æ¦r
         .ControlTipText = Format(Y3, "yyyy/mm/dd")
         '¡ô¥O«ö¶sµù¸Ñ¬O Y3¤é´ÁÅܼƥH yyyy/mm/dd Åã¥Ü
         'ControlTipText ÄÝ©Ê
         'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/controltiptext-property

    End With
Next i
UserForm2.Caption = " " & CB_Yr.Value & "¦~" & CB_Mth.Text
'¡ô¥OUserForm2¼ÐÃD¬O ªÅ¥Õ¦r¤¸³s±µ CB_Yr¤U©Ô¦¡²M³æ¤è¶ô­È³s±µ "¦~" ,³Ì«á³s±µ CB_Mth¤U©Ô¦¡²M³æ¤è¶ô­È
End Sub

Sub ¬Û¤Ïªº_¤Q¤»¶i¦ì()
MsgBox &HFF
MsgBox &HA
MsgBox &HAA
End Sub

Private Sub D1_Click()
    xDate = D1.ControlTipText
    '¡ô³o¸ÌxDate = D2.ControlTipText »Ý­n§ï¬°,xDate = D1.ControlTipText
    Unload Me
End Sub

~~~

Private Sub D42_Click()
    xDate = D42.ControlTipText
    Unload Me
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

Initialize ¨Æ¥ó

USERFORM2_¤ë¥÷¤U©Ô²M³æ:


USERFORM2_¦~¥÷¤U©Ô²M³æ:


Option Explicit
Dim i&
'¡ô«Å§i¼Ò²ÕÅܼÆ:i¬Oªø¾ã¼Æ
Private Sub UserForm_Initialize()
'¡ôInitialize ¨Æ¥ó,·|¦b¸ü¤Jª«¥ó¤§«á¦ýÅã¥Ü¤§«eµo¥Í¡C
CB_Yr = Year(Date)
'¡ô¥OCB_Yr¤U©Ô¦¡²M³æ¤è¶ôÅã¥Ü ¥H¤µ¤Ñ¤é´Á§PÂ_¥Xªº 4½X¦è¤¸¦~¤À
For i = 1 To 12
'¡ô³]¶¶°j°é!i±q1¨ì12
    CB_Mth.AddItem Application.Text(i, "[DBNum1]d¤ë")
    '¡ô¥OCB_Mth¤U©Ô¦¡²M³æ¤è¶ô¥[¤J °j°é¼ÆÂà¤p¼g¤ë¥÷¤å¦r¦r¦êªº²M³æ¶µ¥Ø
    'Text()·|¶Ç¦^«ü©w¤§ª«¥óªº®æ¦¡¤Æ¤å¦r¡C °ßŪªº String
    '[DBNum1]:¤¤¤å¤p¼g ,[DBNum2]:¤¤¤å¤j¼g,¤j¤p¼g­n¦Û¤v¸Õ¤~ª¾¹D

Next i
For i = -20 To 20
'¡ô³]¶¶°j°é!i±q-20¨ì20
    CB_Yr.AddItem CB_Yr + i
    '¡ô¥OCB_Yr¤U©Ô¦¡²M³æ¤è¶ô¥[¤J °j°é¼Æ¥[¤WCB_Yr­È²£¥Íªº41­Ó¦~¥÷¤å¦r¦r¦êªº²M³æ¶µ¥Ø
Next i
'ÁöµM¼W¥[¤F¦h­Ó²M³æ¶µ¥Ø,¦ý¤£¼vÅT¤@¶}©lªºÅã¥Ü(¥H¤µ¤Ñ¤é´Áªº¦~¥÷)
CB_Mth = Application.Text(Date, "[DBNum1]m¤ë")
'¡ô¥OCB_Mth¤U©Ô¦¡²M³æ¤è¶ôÅã¥Ü ¥H¤µ¤Ñ¤é´Á§PÂ_¥Xªº ¤p¼g¤ë¥÷¤å¦r¦r¦ê
Call Build_Calendar
'¡ô°õ¦æ Build_Calendar°Æµ{¦¡
End Sub

Private Sub CB_Mth_Change()
'¡ôCB_Mth¤U©Ô¦¡²M³æ¤è¶ô_Change ¨Æ¥ó
'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/change-event

If UserForm2.Caption Like "*####*" Then Call Build_Calendar
'¡ô¦pªG UserForm2¦Û­qªí³æ ¼ÐÃDµ¡Åã¥Ü¤å¦r ¥]§t4­Ó³sÄòªº¼Æ¦r!´N°õ¦æ Build_Calendar°Æµ{¦¡
End Sub

Private Sub CB_Yr_Change()
'¡ôCB_Yr¤U©Ô¦¡²M³æ¤è¶ô_Change ¨Æ¥ó
If UserForm2.Caption Like "*####*" Then Call Build_Calendar
'¡ô¦pªG UserForm2¦Û­qªí³æ ¼ÐÃDµ¡Åã¥Ü¤å¦r ¥]§t4­Ó³sÄòªº¼Æ¦r!´N°õ¦æ Build_Calendar°Æµ{¦¡
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 5# ­ã´£³¡ªL


    ÁÂÁ wsx1130«e½úµoªí¦¹¥DÃD»P½d¨Ò
ÁÂÁ ­ã´£³¡ªL«e½ú«ü¾É
¾Ç²ß¦Û­qªí³æ¬O¥t¤@­Ó½dÃ¥ªº¾Ç°Ý,ÁÂÁ«e½ú

«ö«ö¶s Åã¥ÜUserForm1:

Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'¡ôMouseDown¡BMouseUp ¨Æ¥ó
'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/mousedown-mouseup-events
'«Å§iÅܼÆ:Button¬Oµu¾ã¼Æ,Shift¬Oµu¾ã¼Æ,X¬O³æºë«×¯BÂI¼Æ,Y¬O³æºë«×¯BÂI¼Æ

UserForm2.Show
'¡ôÅã¥Ü¦WºÙ¬° UserForm2 ¦Û­qªí³æ
TextBox1.Text = xDate
'¡ô¿é¤Jµ¡¤å¦rÅã¥Ü xDateÅܼƦ^¶Çªº­È
End Sub


ÂI¤JUserForm1¿é¤Jµ¡,¸õ¥X·í¤ë¤ë¾ä UserForm2
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¥»©«³Ì«á¥Ñ lee88 ©ó 2022-12-26 15:17 ½s¿è

¦^´_ 6# wsx1130
¾ã²z¤@¤Uµ{¦¡½X
UserForm1ªºµ{¦¡½X
  1. Option Explicit
  2. Private Sub UserForm_Initialize()
  3.     With TextBox1
  4.         .Width = 100
  5.         .Font.Size = 12
  6.         .Font.Bold = True
  7.     End With
  8. End Sub
  9. Private Sub UserForm_Activate()
  10.   If UserForm2.Visible = False Then MsgBox "«ö¤Uªí³æ  ©I¥s ¤é´Áªí³æ"
  11. End Sub
  12. Private Sub UserForm_Click()
  13.   If UserForm2.Visible = False Then UserForm2.Show 0
  14. End Sub
  15. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  16.     If UserForm2.Visible = True Then Unload UserForm2
  17. End Sub
½Æ»s¥N½X
UserForm1ªºµ{¦¡½X
  1.   Option Explicit
  2.     Public Thisday As Date
  3.     Dim CreateCal As Boolean, i As Integer
  4.     Dim Form_Button(1 To 42) As New Class1 '·sªºª«¥ó¼Ò²Õ
  5. Private Sub UserForm_Initialize()
  6.     Thisday = Date
  7.     For i = 1 To 12
  8.         CB_Mth.AddItem Format(DateSerial(Year(Thisday), i, 1), "m¤ë  mmmm")
  9.     Next
  10.     CB_Mth.Value = CB_Mth.List(Month(Thisday) - 1)
  11.     For i = 1980 To 2099 ' PC¤º«Ø¤é´Á¦~«×
  12.         CB_Yr.AddItem i
  13.     Next
  14.     CB_Yr.Value = Year(Thisday)
  15.     Make_com
  16.     CreateCal = True
  17.     Call Build_Calendar
  18.     Application.EnableEvents = True
  19. End Sub
  20. Sub Make_com()
  21.     For i = 1 To 42
  22.        Set Form_Button(i).C_Button = Controls("d" & i)   '±Nªí³æªº±±¨î¶µ ¾É¤J¬°ª«¥ó¼Ò²Õªº±±¨î¶µ
  23.     Next
  24. End Sub
  25. Private Sub CB_Mth_Change()
  26.     'rebuilds the calendar when the month is changed by the user
  27.     Build_Calendar
  28. End Sub
  29. Private Sub CB_Yr_Change()
  30.     'rebuilds the calendar when the year is changed by the user
  31.     Build_Calendar
  32. End Sub
  33. Private Sub Build_Calendar()
  34.     'the routine that actually builds the calendar each time
  35.     Dim S_Day As Date, Msg As Boolean
  36.     If CreateCal = False Then Exit Sub
  37.     UserForm2.Caption = " " & CB_Mth.Value & " " & CB_Yr.Value
  38.     S_Day = DateSerial(CB_Yr, CB_Mth.ListIndex + 1, 1) - Weekday(DateSerial(CB_Yr, CB_Mth.ListIndex + 1, 1), vbMonday)
  39.     'S_Day =  42­Ó«öÁ䪺²Ä¤@¤Ñ
  40.     For i = 1 To 42
  41.         Msg = Month(S_Day + i - 1) = CB_Mth.ListIndex + 1
  42.         With Controls("d" & i)
  43.                 .ControlTipText = S_Day + i - 1
  44.                 .Caption = Day(S_Day + i - 1)            '«ü©w¤é´Á
  45.                 .Font.Bold = Msg ' True                    '<-©w²ÊÅé
  46.                 .ForeColor = IIf(Msg, vbBlack, vbWhite) 'Fc '¦rÅéÃC¦â
  47.                 .ForeColor = IIf(Weekday(.ControlTipText) > 6 Or Weekday(.ControlTipText) = 1, vbRed, IIf(Msg, vbBlack, vbWhite))
  48.                 .BackColor = IIf(Msg, vbCyan, vbBlack)              '­I´ºÃC¦â
  49.         End With
  50.     Next
  51. End Sub
  52. Private Sub UserForm_RemoveControl(ByVal Control As MSForms.Control)
  53.     Unload Me
  54. End Sub
½Æ»s¥N½X
**¶·¦b±M®×µøµ¡¥[¤W¤@­Ó ª«¥óÃþ§O¼Ò²Õ ·|¦Û°Ê©R¦W¬°Class1(¦WºÙ¥i­×§ï)
Class1ªºµ{¦¡½X
  1. Option Explicit
  2. Public WithEvents C_Button    As MSForms.CommandButton
  3. Private Sub C_Button_Click()
  4.         With C_Button.Parent.Parent.Parent
  5.             ' 42­Ó«öÁ䪺.Parent = Frame1->Frame1.Parent=.Frame2->Frame2.Parent=UserForm2
  6.             .Thisday = C_Button.ControlTipText
  7.             UserForm1.TextBox1 = .Thisday
  8.         End With
  9. End Sub
½Æ»s¥N½X

TOP

¦^´_ 5# ­ã´£³¡ªL
·PÁ¦U¦ì°ª¤âªºÀ°¦£¡Aªº½T¬O§Ú­nªº®ÄªG
ÁÂÁÂ

TOP

¤ë¾ä¤£¶·¨º»ò½ÆÂø//¥u­nºâ¥X¨C¤ë1¤é¬O¬P´Á´X, ¦A¤Ï±À¨º©Pªº¬P´Á¤é¬O­þ¤@¤Ñ//
Xl0000351-1.rar (19.61 KB)

­Y­n¥[¤J¥xÆW³s°²¤Î¸É¯Z¤é, ÁÙ¶·¦A¥[­Ó¹ï·Óªí(¤H¤u--¨S®É¶¡°µ), ¦A¥Î¦r¨å¦s¨ú~~

TOP

¦^´_  wsx1130


¤é´Á¿ï¾Ü¾¹¬O´X¦~«e¼gªº
·í®É¤£¤Ó·|¼g ³£¬Oµw·F  ¤@¦æ¤@¦æµwïÈ

§A¤]¥i¥H¨Ï¥Î·Pı ...
singo1232001 µoªí©ó 2022-12-25 10:59



    °ÆÀɦWxlsm... ¥¨¶°¼Ò¦¡
    ¨ä¹ê¤£¥Î§ï¤]¥i¶}±Ò(¦ý 2003  ·|µLªkÃѧO xlsmÀÉ®×)

  ¦h°µ¦h·Q¦h¾Ç²ß¡A¤Ö¬Ý¤Ö¿ù¤Ö°g³~

  ¦h°µ=¦h¦h½m²ß¡A¦h¦h½s¼g¡C
  ¦h·Q=·Q·Q¬°¤°»ò¤H®aµ{¦¡­n¨º¼Ë¼g¡A¦pªG´«¦¨¦Û¤v¡A¤S·|«ç¼g¡C
  ¦h¾Ç²ß=¾Ç²ß¤H®aªºµo°Ý¨Ã¸Ñµª¡A¾Ç²ß¤H®aªº¼gªk

  ¤Ö¬Ý=¥u¬Ý¤£°µ¤]ªPµM

TOP

¦^´_ 1# wsx1130


¤é´Á¿ï¾Ü¾¹¬O´X¦~«e¼gªº
·í®É¤£¤Ó·|¼g ³£¬Oµw·F  ¤@¦æ¤@¦æµwïÈ

§A¤]¥i¥H¨Ï¥Î·Pı¬Ý¬Ý
¹ê¥Î©ÊÀ³¸Ó¤£¿ù
¦ý¬ü¤Æ0¤À

¥t¥~´£¤@ÂI ¦n¹³²{¦bªºÀÉ®× ³£­n§ïÀɦW¥t¦s·sÀɤ~¯à¶} ¤£ª¾¹D¬O¤£¬O·L³n¥¨¶°­·ÀI¤S§ï¤F

¤é´Á¿ï¾Ü¾¹.zip (40.73 KB)

TOP

¥»©«³Ì«á¥Ñ singo1232001 ©ó 2022-12-25 10:51 ½s¿è

¦^´_ 1# wsx1130


v1¸òv2³£¤@¼Ë  ¥u¬O®t¦b¼gªk¤£¦P
v3¦³§â¤é´Áªº ¦~¤ë¤éÂ\©ñ¶¶§Ç ½Õ¾ã¦¨¤@¯ë±`¥Î®æ¦¡

test v1.zip (34.63 KB)

test v2.zip (43.43 KB)

test v3.zip (44.03 KB)

TOP

        ÀR«ä¦Û¦b : §Ú­Ì­n°µ¦nªÀ·|ªºÀô«O¡A¤]­n°µ¦n¤º¤ßªºÀô«O¡C
ªð¦^¦Cªí ¤W¤@¥DÃD