Board logo

標題: 各位大大，請問UserForm表單如何讀取子表單 [打印本頁]
作者: wsx1130    時間: 2022-12-24 15:55     標題: 各位大大，請問UserForm表單如何讀取子表單

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

選擇日期後自動填回textbox1
作者: singo1232001    時間: 2022-12-25 10:40

本帖最後由 singo1232001 於 2022-12-25 10:51 編輯

回復 1# wsx1130


v1跟v2都一樣  只是差在寫法不同
v3有把日期的 年月日擺放順序 調整成一般常用格式
作者: singo1232001    時間: 2022-12-25 10:59

回復 1# wsx1130


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

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

另外提一點 好像現在的檔案 都要改檔名另存新檔才能開 不知道是不是微軟巨集風險又改了
作者: mark15jill    時間: 2022-12-25 13:38

回復  wsx1130


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

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



    副檔名xlsm... 巨集模式
    其實不用改也可開啟(但 2003  會無法識別 xlsm檔案)
作者: 准提部林    時間: 2022-12-25 17:21

月曆不須那麼複雜//只要算出每月1日是星期幾, 再反推那周的星期日是哪一天//
[attach]35656[/attach]

若要加入台灣連假及補班日, 還須再加個對照表(人工--沒時間做), 再用字典存取~~
作者: wsx1130    時間: 2022-12-25 19:32

回復 5# 准提部林
感謝各位高手的幫忙，的確是我要的效果
謝謝
作者: lee88    時間: 2022-12-26 15:15

本帖最後由 lee88 於 2022-12-26 15:17 編輯

回復 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    時間: 2022-12-27 07:57

回復 5# 准提部林


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

按按鈕 顯示UserForm1:
[attach]35661[/attach]
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
[attach]35662[/attach]
作者: Andy2483    時間: 2022-12-27 08:50

Initialize 事件

USERFORM2_月份下拉清單:
[attach]35663[/attach]

USERFORM2_年份下拉清單:
[attach]35664[/attach]

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    時間: 2022-12-27 11:07

本帖最後由 Andy2483 於 2022-12-27 11:10 編輯

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

按鈕註解:
[attach]35665[/attach]

按按鈕後結果:
[attach]35666[/attach]

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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)