首页 > 解决方案 > 有没有办法用脚本字典中的值填充用户窗体列表框?

问题描述

我正在尝试使用相同的脚本字典填充两个不同的列表框,但它不起作用。

我有两个正在运行的潜艇,一个调用另一个。

这是原始的子(工作代码):

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

我期待“资本调用”用户表单中的列表填充字典中的键和项目,但它出现空白。

任何想法为什么?

标签: excelvbauserform

解决方案


从我上面发布的链接开始:

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

推荐阅读