各位大大，請問UserForm表單如何讀取子表單

wsx1130

各位大大，請各位幫忙在userform1點選textbox1中自動彈出UserForm2

選擇日期後自動填回textbox1

singo1232001

回復 1# wsx1130


v1跟v2都一樣  只是差在寫法不同
v3有把日期的 年月日擺放順序 調整成一般常用格式

singo1232001

回復 1# wsx1130


日期選擇器是幾年前寫的
當時不太會寫 都是硬幹  一行一行硬懟

你也可以使用感覺看看
實用性應該不錯
但美化0分

另外提一點 好像現在的檔案 都要改檔名另存新檔才能開 不知道是不是微軟巨集風險又改了

mark15jill

回復  wsx1130


日期選擇器是幾年前寫的
當時不太會寫 都是硬幹  一行一行硬懟

你也可以使用感覺 ...
singo1232001 發表於 2022-12-25 10:59

    副檔名xlsm... 巨集模式
    其實不用改也可開啟(但 2003  會無法識別 xlsm檔案)

准提部林

月曆不須那麼複雜//只要算出每月1日是星期幾, 再反推那周的星期日是哪一天//
Xl0000351-1.rar (19.61 KB)

下載次數: 15

2022-12-25 17:18

若要加入台灣連假及補班日, 還須再加個對照表(人工--沒時間做), 再用字典存取~~

wsx1130

回復 5# 准提部林
感謝各位高手的幫忙，的確是我要的效果
謝謝

lee88

回復 6# wsx1130
整理一下程式碼
UserForm1的程式碼

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 "按下表單  呼叫 日期表單"
    
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

複製代碼

UserForm1的程式碼

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 '新的物件模組
   
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)   '將表單的控制項 導入為物件模組的控制項
    
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)            '指定日期
    
45.                 .Font.Bold = Msg ' True                    '<-定粗體
    
46.                 .ForeColor = IIf(Msg, vbBlack, vbWhite) 'Fc '字體顏色
    
47.                 .ForeColor = IIf(Weekday(.ControlTipText) > 6 Or Weekday(.ControlTipText) = 1, vbRed, IIf(Msg, vbBlack, vbWhite))
    
48.                 .BackColor = IIf(Msg, vbCyan, vbBlack)              '背景顏色
    
49.         End With
    
50.     Next
    
51. End Sub
    
52. Private Sub UserForm_RemoveControl(ByVal Control As MSForms.Control)
    
53.     Unload Me
    
54. End Sub

複製代碼

**須在專案視窗加上一個 物件類別模組 會自動命名為Class1(名稱可修改)
Class1的程式碼

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

複製代碼

Andy2483

回復 5# 准提部林


    謝謝 wsx1130前輩發表此主題與範例
謝謝 准提部林前輩指導
學習自訂表單是另一個範疇的學問,謝謝前輩

按按鈕 顯示UserForm1:

下載 (75.43 KB)

2022-12-27 07:52

Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'↑MouseDown、MouseUp 事件
'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/mousedown-mouseup-events
'宣告變數:Button是短整數,Shift是短整數,X是單精度浮點數,Y是單精度浮點數
UserForm2.Show
'↑顯示名稱為 UserForm2 自訂表單
TextBox1.Text = xDate
'↑輸入窗文字顯示 xDate變數回傳的值
End Sub


點入UserForm1輸入窗,跳出當月月曆 UserForm2

下載 (99.89 KB)

2022-12-27 07:53

Andy2483

Initialize 事件

USERFORM2_月份下拉清單:

下載 (95.33 KB)

2022-12-27 08:46

USERFORM2_年份下拉清單:

下載 (101.01 KB)

2022-12-27 08:47

Option Explicit
Dim i&
'↑宣告模組變數:i是長整數
Private Sub UserForm_Initialize()
'↑Initialize 事件,會在載入物件之後但顯示之前發生。
CB_Yr = Year(Date)
'↑令CB_Yr下拉式清單方塊顯示 以今天日期判斷出的 4碼西元年分
For i = 1 To 12
'↑設順迴圈!i從1到12
    CB_Mth.AddItem Application.Text(i, "[DBNum1]d月")
    '↑令CB_Mth下拉式清單方塊加入 迴圈數轉小寫月份文字字串的清單項目
    'Text()會傳回指定之物件的格式化文字。 唯讀的 String
    '[DBNum1]:中文小寫 ,[DBNum2]:中文大寫,大小寫要自己試才知道
Next i
For i = -20 To 20
'↑設順迴圈!i從-20到20
    CB_Yr.AddItem CB_Yr + i
    '↑令CB_Yr下拉式清單方塊加入 迴圈數加上CB_Yr值產生的41個年份文字字串的清單項目
Next i
'雖然增加了多個清單項目,但不影響一開始的顯示(以今天日期的年份)
CB_Mth = Application.Text(Date, "[DBNum1]m月")
'↑令CB_Mth下拉式清單方塊顯示 以今天日期判斷出的 小寫月份文字字串
Call Build_Calendar
'↑執行 Build_Calendar副程式
End Sub

Private Sub CB_Mth_Change()
'↑CB_Mth下拉式清單方塊_Change 事件
'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/change-event
If UserForm2.Caption Like "*####*" Then Call Build_Calendar
'↑如果 UserForm2自訂表單 標題窗顯示文字 包含4個連續的數字!就執行 Build_Calendar副程式
End Sub

Private Sub CB_Yr_Change()
'↑CB_Yr下拉式清單方塊_Change 事件
If UserForm2.Caption Like "*####*" Then Call Build_Calendar
'↑如果 UserForm2自訂表單 標題窗顯示文字 包含4個連續的數字!就執行 Build_Calendar副程式
End Sub

Andy2483

再次謝謝 准提部林前輩指導

按鈕註解:

下載 (98.43 KB)

2022-12-27 11:00

按按鈕後結果:

下載 (73.24 KB)

2022-12-27 11:01

Private Sub Build_Calendar()
Dim Y0 As Date, Y1 As Date, Y2 As Date, Y3 As Date, Fb, Fc, Fu, Fs, Bc
'↑宣告變數:(Y0,Y1,Y2,Y3)是日期變數,其他是通用型變數
Y1 = DateSerial(CB_Yr, CB_Mth.ListIndex + 1, 1)
'↑令Y1這日期變數是 DateSerial(yyyy,m,d) 組合出想要的西元年/月/日(yyyy/m/d)(月初日)
'CB_Mth.ListIndex + 1 的意思用猜的:CB_Mth下拉式清單方塊顯示值所在的清單索引位置,而其清單索引是0~11 (猜的!)

'DateSerial 函數
'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/dateserial-function

'ListIndex 屬性,識別 ListBox 或 ComboBox 中目前選取的專案。
'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/listindex-property
Y2 = DateAdd("m", 1, Y1) - 1
'↑令Y2這日期變數是 DateAdd(m換算的天數:28、29、30或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
'↑令Y0是 [Y1變數(月初日) -  Y1變數(月初日)的前一天 除7 的餘數(先除出餘數再相減)] 的日期
'這是要算月曆的第一天
For i = 1 To 42
'↑設順迴圈!i從1到42
    Y3 = Y0 + i - 1
    '↑令Y3這日期變數是 月曆的第一天+i迴圈數 -1
    Fb = True
    '↑令Fb這通用變數是 布林值 True
    Fs = 12
    '↑令Fs這通用變數是 12
    Fu = False
    '↑令Fu這通用變數是 布林值 False
    Fc = &H80000012
    '↑令Fu這通用變數是 Windows 按鈕上的文字顏色代號
    '系統顏色常量
    '搜尋 VBA 系統顏色常量
    Bc = &H8000000F
    '↑令Bc是 BackColor 屬性的值設定為 Windows 表單中的預設值
    'https://learn.microsoft.com/zh-tw/office/vba/api/visio.viewer.backcolor
    If Y3 Mod 7 < 2 Then Fc = &HFF
    '↑如果Y3日期變數除7後的餘數 <2 ,就令Fu這通用變數是 255
    'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/hex-function
    If Y3 < Y1 Or Y3 > Y2 Then
    '↑如果Y3日期變數 < Y1日期變數(月初日) 或 Y3日期變數 >Y1日期變數(月尾日),
       Fb = False
       '↑令Fb這通用變數是 布林值 False
       Fu = True
       '↑令Fu這通用變數是 布林值 True
       Fs = 11
       '↑令Fs這通用變數是 11
       Bc = &H808080
       '↑令Bc這通用變數是 Windows 系統顏色代號(灰色的)
    End If
    With UserForm2("D" & i)
    '↑以下是關於UserForm2 42個日期按鈕的程序
         .Font.Bold = Fb '粗體
         .Font.Size = Fs '字體大小
         .Font.Underline = Fu '非本月-加底線
         .ForeColor = Fc '字體顏色
         .BackColor = Bc '背景顏色
         .Caption = Day(Y3)
         '↑令按鈕顯示文字是 Day()擷取Y3日期變數 日數字
         .ControlTipText = Format(Y3, "yyyy/mm/dd")
         '↑令按鈕註解是 Y3日期變數以 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
'↑令UserForm2標題是 空白字元連接 CB_Yr下拉式清單方塊值連接 "年" ,最後連接 CB_Mth下拉式清單方塊值
End Sub

Sub 相反的_十六進位()
MsgBox &HFF
MsgBox &HA
MsgBox &HAA
End Sub

Private Sub D1_Click()
    xDate = D1.ControlTipText
    '↑這裡xDate = D2.ControlTipText 需要改為,xDate = D1.ControlTipText
    Unload Me
End Sub

~~~

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