[發問] 選擇ListBox內資料如何放到其他UserForm的TextBox

kkooo15

下載 (67.49 KB)

2019-7-27 12:21

問題一
請問要如何可以點選ListBox的其中的資料後
按確定可以將點選的"編號"放到UserForm2的TextBox1

問題二
如果我有二個UserForm
我選UserForm2使用查詢時，"編號"就會存在UserForm2的TextBox1
我選UserForm3使用查詢時，"編號"就會存在UserForm3的TextBox1

1. Option Explicit
   
2. Dim xSh As Worksheet, xRng(1 To 3) As Range, Msg單號 As Boolean, d As Object, d2 As Object, d3 As Object
   
3. Private Sub CommandButton6_Click()
   
4.     If TextBox1.Text <> "" Then
   
5.     '將 UserForm2查出來的編號 資料放入 UserForm1的TextBox1
   
6.     UserForm1.TextBox1.Text = UserForm2.TextBox1.Text
   
7.     '將 TextBox1 資料放入 TBox1
   
8.     Unload UserForm2
   
9.     '關閉表單
   
10.     Else
    
11.     End If
    
12. End Sub
    
13. 
    
14. Private Sub UserForm_Initialize()
    
15.     Set xSh = Sheets("清單")
    
16.     '宣告 xSH = Sheets("清單")
    
17. 
    
18.     MultiPage1.Value = 0
    
19.     Show_List
    
20.     Dim i As Single, Rng As Range
    
21.     Set d = CreateObject("scripting.dictionary")
    
22.     '宣告 d = 建立並傳回 ActiveX 物件 建立一個 Dictionary物件
    
23.     Set Rng = xSh.Cells(5, "D")
    
24.     'xSH = Sheets("基本資料") Rng =儲存格 Cells(第5欄,C列)
    
25.     Do While Rng <> ""
    
26.     'Rng = 儲存格 Cells(第5欄,C列) 不等於  空白
    
27.         If d.exists(Rng.Value) = False Then
    
28.             '
    
29.             Set d(Rng.Value) = Rng
    
30.         Else
    
31.             Set d(Rng.Value) = Union(Rng, d(Rng.Value))
    
32.         End If
    
33.         Set Rng = Rng.Offset(1)
    
34.     Loop
    
35.     ComboBox1.List = d.KEYS
    
36.     'ComboBox1 等於 d KEYS
    
37. End Sub
    
38. 
    
39. Private Sub SpinButton1_Change()
    
40.     單號.Caption = SpinButton1
    
41.     Msg單號 = True
    
42.     Show_List
    
43.     Msg單號 = False
    
44. End Sub
    
45. 
    
46. Private Sub Show_List()
    
47.     Dim i As Integer, E As Variant
    
48.     Set xRng(1) = xSh.Range("c4").CurrentRegion
    
49.     With xSh
    
50.         i = .Columns.Count
    
51.         Set xRng(1) = .Range("c4").CurrentRegion
    
52.         Set xRng(2) = .Cells(1, i).CurrentRegion
    
53.         xRng(2).Clear
    
54.         If Msg單號 Then
    
55.             .Cells(1, i) = "單號"
    
56.             .Cells(2, i) = SpinButton1
    
57.         Else
    
58.         End If
    
59.         Set xRng(2) = .Cells(1, i).CurrentRegion
    
60.     End With
    
61.     Set xRng(3) = xRng(2).Cells(1).Offset(, -20).Resize(, xRng(1).Columns.Count)
    
62.     xRng(3).CurrentRegion.Clear
    
63.     xRng(1).AdvancedFilter xlFilterCopy, xRng(2), xRng(3)
    
64.     Set xRng(3) = xRng(3).CurrentRegion
    
65.     If xRng(3).Rows.Count > 2 Then
    
66.         Set xRng(3) = xRng(3).Rows("2:" & xRng(3).Rows.Count)
    
67.     Else
    
68.         Set xRng(3) = xRng(3).Rows(2)
    
69.     End If
    
70.     With ListBox1
    
71.         .ColumnHeads = True
    
72.         .ColumnCount = -1
    
73.         .RowSource = xRng(3).Address(, , , 1, 1)
    
74.     End With
    
75.     xRng(2).Clear
    
76. End Sub

複製代碼

ZA0004001.rar (33.14 KB)

下載次數: 3

2019-7-27 12:23

kkooo15

回復 1# kkooo15

問題二
如果我有二個UserForm
我選UserForm2使用查詢時，"編號"就會存在UserForm2的TextBox1
我選UserForm3使用查詢時，"編號"就會存在UserForm3的TextBox1

我想到辦法解決了。

就是在開表單的時候把資料清空。

1. Sub show1()
   
2.     UserForm1.show
   
3. End Sub
   
4. Sub show2()
   
5.     '開啟表單時清空TEXTBOX1內的資料
   
6.     UserForm2.TextBox1.Text = ""
   
7.     UserForm2.show
   
8. End Sub
   
9. Sub show3()
   
10.     '開啟表單時清空TEXTBOX1內的資料
    
11.     UserForm3.TextBox1.Text = ""
    
12.     UserForm3.show
    
13. End Sub

複製代碼

然後得到資料後按確定時
UserForm2跟UserForm3都放資料

1. Private Sub CommandButton6_Click()
   
2.     If TextBox1.Text <> "" Then
   
3.     '將 UserForm2查出來的編號 資料放入 UserForm1的TextBox1
   
4.     UserForm2.TextBox1.Text = UserForm1.TextBox1.Text
   
5.     UserForm3.TextBox1.Text = UserForm1.TextBox1.Text
   
6.     '將 TextBox1 資料放入 TBox1
   
7.     Unload Me
   
8.     '關閉表單
   
9.     Else
   
10.     End If
    
11. End Sub

複製代碼

現在差..我要怎麼進去點ListBox內資料後，會放到上個的TextBox

ZA0004001-1.rar (33.63 KB)

下載次數: 7

2019-7-29 23:25

kkooo15

回復 3# ciboybj

太感謝了
我又可以在往前一步了