excel - 有没有办法用脚本字典中的值填充用户窗体列表框?
问题描述
我正在尝试使用相同的脚本字典填充两个不同的列表框,但它不起作用。
我有两个正在运行的潜艇,一个调用另一个。
这是原始的子(工作代码):
Option Explicit
Option Base 1
Sub NewWire()
Call PopulateClientName
NewWireForm.Show
End Sub
Sub PopulateClientName()
Dim FileName As String
Dim twb As Workbook, awb As Workbook
Dim aws As Worksheet, tws As Worksheet, ws As Worksheet
Dim rg1 As Range, rg2 As Variant
Dim rCell As Range
'//Clear combobox
DirectCalls.ClientName.Clear
ThirdParty.ClientName.Clear
Transfers.ClientName.Clear
'Open Master Client List
Set twb = ThisWorkbook
Set tws = ThisWorkbook.Worksheets("New")
tws.Visible = True
FileName = "C:\Users\nleon\Documents\Client Master List.xlsx"
Application.ScreenUpdating = False
Workbooks.Open FileName
Set awb = ActiveWorkbook
Set aws = awb.Worksheets("Client Info")
Set ws = awb.Worksheets("Fund Info")
Set rg1 = aws.Range("A1").CurrentRegion
Set rg2 = ws.Range("A2").CurrentRegion
With CreateObject("Scripting.Dictionary")
For Each rCell In aws.Range("B2", aws.Cells(Rows.Count, "B").End(xlUp))
If Not .exists(rCell.Value) Then
.Add rCell.Value, Nothing
End If
Next rCell
DirectCalls.ClientName.List = .Keys
ThirdParty.ClientName.List = .Keys
Transfers.ClientName.List = .Keys
End With
Call PopulateClientNo(rg1, aws)
Call PopulateFund(rg2, ws)
awb.Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub
Sub PopulateClientNo(rg1 As Range, aws As Worksheet)
Dim ws As Worksheet, wb As Workbook
Dim rCell As Range
'//Clear combobox
DirectCalls.ClientNo.Clear
ThirdParty.ClientNo.Clear
Transfers.ClientNo.Clear
With CreateObject("Scripting.Dictionary")
For Each rCell In aws.Range("C2", aws.Cells(Rows.Count, "C").End(xlUp))
If Not .exists(rCell.Value) Then
.Add rCell.Value, Nothing
End If
Next rCell
DirectCalls.ClientNo.List = .Keys
ThirdParty.ClientNo.List = .Keys
Transfers.ClientNo.List = .Keys
End With
End Sub
这是子不起作用:
Sub PopulateFund(rg2 As Variant, ws As Worksheet)
Dim dict As Object, d As Variant
Dim result As Long
Dim i As Integer, j As Integer, v As Variant
CapitalCalls.DCMFund.Clear
CapitalCalls.FundDesc.Clear
d = rg2.Value2
If Not IsArray(d) Then d = Array(d)
Debug.Print IsArray(d)
Set dict = CreateObject("scripting.dictionary")
On Error Resume Next
For i = 2 To UBound(d, 1)
For j = 2 To 2
If dict.exists(d(i, j)) = False Then
dict.Add Key:=d(i, j), Item:=d(i, j + 1)
Else
result = result + d(i, j)
End If
Next j
Next i
CapitalCalls.DCMFund.List = dict.Keys -----> this isn't actually working
CapitalCalls.FundDesc.List = dict.Item -----> this isn't actually working
End Sub
在名为“NewWireForm”的用户窗体中存在以下代码:
Option Base 1
Private Sub CancelButton_Click()
Unload Me
End
End Sub
Private Sub UserForm_Initialize()
With Frame1
With .Font
.Bold = False
.Name = "Ariel"
.Size = 14
End With
End With
End Sub
Private Sub NextButton_Click()
If TPExpense = True Then
ThirdParty.Show
ElseIf DCMCC = True Then
CapitalCalls.Show
ElseIf DirectCC = True Then
DirectCalls.Show
ElseIf Transfer = True Then
Transfers.Show
Else: MsgBox ("You have not selected a wire type. Please try again!.")
End If
End Sub
我期待“资本调用”用户表单中的列表填充字典中的键和项目,但它出现空白。
任何想法为什么?
解决方案
从我上面发布的链接开始:
Sub UserFormStuff()
'setup: "UserForm1" is a userform with 2 textboxes
'this code relies on the "default instance"
UserForm1.TextBox1 = "Test1"
Test2
UserForm1.Show '<< only textbox1 has content
'this code uses an explicit instance of the userform
Dim uf As UserForm1
Set uf = New UserForm1
uf.TextBox1 = "Test1 new"
Test2_new uf '<< pass our explicit instance to Test2_new
uf.Show '<< now both textboxes are populated
End Sub
Sub Test2()
UserForm1.TextBox2 = "Test2" 'this just creates a *new* UserForm1
' which is not the same as the copy used
' in the sub which calls this
End Sub
Sub Test2_new(uf As UserForm1)
uf.TextBox2 = "Test2" '<< use the provided instance
End Sub
推荐阅读
- selenium - 如何定位角根元素?
- nginx - React app - nginx 服务器上所有具有动态 URL 的页面的空白页面
- amazon-web-services - 我可以创建同一个 ec2 图像的多个实例吗
- android - 在 RecyclerView 中的 ViewPager 片段中获取“java.lang.IllegalArgumentException: No view found for id”
- reactjs - 打字稿反应:类型推断不适用于回调参考
- javascript - 在Javascript中发送没有字符串化的对象数组作为POST数据
- python - Instaloader get_followers 问题
- c# - SOAP 消息被截断和标头重复的原因?
- xaml - Xamarin 表单工具栏项在选项卡式页面中出现两次
- openssl - 处理 AppStoreConnect 证书