VBA Excel组合框在用户窗体

Question

基本上，“入职”模块会询问我要更新的跟踪器的路径。 我正在更新跟踪器的sheet1中的详细信息。 我将用户窗体“ OnboardingForm”中的字段的值设置为空白（这样，当我这次打开窗体时，上次输入窗体的值将不可见。现在，我打开窗体“ OnboardingForm”并在窗体中输入值我在用户窗体“ OnboardingForm”中放置了一个对前端用户不可见的复选框，现在在跟踪器中有一个名为“ Project Tracks”的工作表，其中包含所有当前项目的信息。单击该控件将转到跟踪器的“项目跟踪”工作表，它将使用在跟踪器的“项目跟踪”工作表中显示的跟踪验证在用户表单“ OnboardingForm”中输入的跟踪。一旦找到该跟踪的其他详细信息提取到跟踪器的sheet1（这样做是为了使我不必手动向用户表单“ OnboardingForm”输入值，从而使表单看起来很简单）。跟踪没有机会不匹配。

现在，在我当前的用户窗体“ OnboardingForm”中放置了一个命令按钮新轨道。 单击此按钮后，会将控件带到userform2“ ProjectTracksForm”。基本上，因此，如果我要添加新轨道，该表单将获取详细信息并输入到跟踪器的“项目轨道”表中。

问题1>我当前用户窗体的“跟踪”按钮是一个组合框。 如何在跟踪器的“项目跟踪器”工作表的下拉列表中向下拉列表添加值。

问题2>在userform2'ProjectTracksForm'中添加新轨道后，提交，然后返回到当前用户窗体'OnboardingForm'，添加的轨道应显示在“轨道”组合框的下拉列表中。 请在我的代码下面找到。

这是我的入门模块

Public Sub OnBoarding()
    On Error GoTo ErrorHandler
    Dim Owb As Object
    Dim ran As Range
    strTalentTrackerPath = shTracker.Cells(2, 2).Value

    'Default the form values to null
    With OnboardingForm
        .combTrackofWork.Value = ""
        .txtFirstName.Text = ""
        .txtLastName.Text = ""
        .combResCat.Value = ""
        .combBFTE.Value = ""
        .combLevel.Value = ""
        .combLocType = ""
        .txtAccessInfo.Text = ""
    End With
    OnboardingForm.Show
    SetFocus.combTrackofWork

    With OnboardingForm
        'Details to be entered in the form'
        strTOW = Trim$(.combTrackofWork.Value)
        strFN = Trim$(.txtFirstName.Text)
        strLN = Trim$(.txtLastName.Text)
        strResCat = Trim$(.combResCat.Value)
        strBilFTE = Trim$(.combBFTE.Value)
        strLevel = Trim$(.combLevel.Value)
        strLocType = (.combLocType.Value)
        strAccessInfo = (.txtAccessInfo.Text)
    End With

    If OnboardingForm.chkOKButtonClick = True Then
        Set oExcel = New Excel.Application
        strMyFolder = strTalentTrackerPath
        Set Owb = oExcel.Workbooks.Open(strMyFolder)
        IntRowCount = Owb.Sheets(1).UsedRange.Rows.Count
        With Owb.Sheets(1)
            With Owb.Sheets("Project Tracks")
                IntTrackRowCount = .UsedRange.Rows.Count
                For IntCurrentRow = 1 To IntTrackRowCount
                    If .Cells(IntCurrentRow, 1) = strTOW Then
                        Owb.Sheets(1).Cells(IntRowCount + 1, OnboardingFormcolumn.colTrackofWork) _
                                = .Cells(IntCurrentRow, ProjectTrackscolumn.colTrack)
                        Owb.Sheets(1).Cells(IntRowCount + 1, OnboardingFormcolumn.colBPO) = .Cells _
                                                                                            (IntCurrentRow, ProjectTrackscolumn.colBPO)
                        Owb.Sheets(1).Cells(IntRowCount + 1, OnboardingFormcolumn.colCostCenter) _
                                = .Cells(IntCurrentRow, ProjectTrackscolumn.colCostCenter)
                        Owb.Sheets(1).Cells(IntRowCount + 1, OnboardingFormcolumn.colGroup) _
                                = .Cells(IntCurrentRow, ProjectTrackscolumn.colGroup)
                        Exit For
                    End If
                Next
            End With
        End With
        .Cells(IntRowCount + 1, OnboardingFormcolumn.colTrackofWork) = strTOW
        .Cells(IntRowCount + 1, OnboardingFormcolumn.colFirstName) = strFN
        .Cells(IntRowCount + 1, OnboardingFormcolumn.colLastName) = strLN
        .Cells(IntRowCount + 1, OnboardingFormcolumn.colResourceCategory) = strResCat
        .Cells(IntRowCount + 1, OnboardingFormcolumn.colBilledFTE) = strBilFTE
        .Cells(IntRowCount + 1, OnboardingFormcolumn.colLevel) = strLevel
        .Cells(IntRowCount + 1, OnboardingFormcolumn.colLocationType) = strLocType
        .Cells(IntRowCount + 1, OnboardingFormcolumn.colAccessInformation) = strAccessInfo

        Owb.Close True
        Set Owb = Nothing
        Set oExcel = Nothing
    Else
        Exit Sub
    End If
    Exit Sub

ErrorHandler:
    If Owb Is Nothing Then
    Else
        Owb.Close False
    End If
    If oExcel Is Nothing Then
    Else
        Set oExcel = Nothing
    End If
    MsgBox "Unhandled Error. Please Report" & vbCrLf & "Error Description: " & _
           Err.Description, vbExclamation
End Sub

这是入职表格的取消按钮

Private Sub cmdbtn_Cancel_Click()
    OnboardingForm.Hide
    MsgBox ("No data entered")
End Sub

这是用于OnboardingForm提交按钮

Private Sub cmdbtn_Submit_Click()
    If Trim(OnboardingForm.combTrackOfWork.Value) = ""  Then
        OnboardingForm.combTOW.SetFocus
        MsgBox ("Track of Work cannot be blank")
        Exit Sub
    End If
    If Trim(OnboardingForm.txtFirstName.Value) = "" Then
        OnboardingForm.txtFN.SetFocus
        MsgBox ("First name cannot be blank")
        Exit Sub
    End If
    If Trim(OnboardingForm.txtLastName.Value) = "" Then
        OnboardingForm.txtLN.SetFocus
        MsgBox ("Last name cannot be blank")
        Exit Sub
    End If
End Sub

项目跟踪模块

Public Sub prjctTracks()
    On Error GoTo ErrorHandler
    Dim Owb As Object
    strTalentTrackerPath = shTracker.Cells(2, 2).Value
    With ProjectTracksForm
        .txtTOW = ""
        .txtBPO = ""
        .txtCOCE = ""
        .txtSOW = ""
        .txtGroup = ""
    End With
    ProjectTracksForm.Show
    With ProjectTracksForm
        strTOW = Trim$(.txtTOW.Text)
        strBPO = Trim$(.txtBPO.Text)
        strCOCE = Trim$(.txtCOCE.Text)
        strSOW = Trim$(.txtSOW.Value)
        strGroup = Trim$(.txtGroup.Value)
    End With
    ProjectTracksForm.Hide
    If ProjectTracksForm.chkbtn_OKclick = True Then
        Set oExcel = New Excel.Application
        strMyFolder = strTalentTrackerPath
        Set Owb = oExcel.Workbooks.Open(strMyFolder)
        With Owb.Sheets("Project Tracks")
            intUsedRowCount = .UsedRange.Rows.Count
            .Cells(intUsedRowCount + 1, Trackscolumn.colTrack) = strTOW
            .Cells(intUsedRowCount + 1, Trackscolumn.colBPO) = strBPO
            .Cells(intUsedRowCount + 1, Trackscolumn.colCostCenter) = strCOCE
            .Cells(intUsedRowCount + 1, Trackscolumn.colSOW) = strSOW
            .Cells(intUsedRowCount + 1, Trackscolumn.colGroup) = strGroup
        End With
        Owb.Close True
        Set Owb = Nothing
        Set oExcel = Nothing
    Else
        Exit Sub
    End If
    Exit Sub
ErrorHandler:
    If Owb Is Nothing Then
    Else
        Owb.Close False
    End If
    If oExcel Is Nothing Then
    Else
        Set oExcel = Nothing
    End If
    MsgBox "Unhandled Error. Please Report" & vbCrLf & "Error Description: " & _
           Err.Description, vbExclamation
End Sub

Answer 1

问题1>我当前用户窗体的“跟踪”按钮是一个组合框。 如何在跟踪器的“项目跟踪器”工作表的下拉列表中向下拉列表添加值。

在此示例中，我将组合框称为“ ComboBox1”

放置在组合框中的范围看起来像这样...

填充组合框的代码将在用户表单模块中。

Private Sub UserForm_Initialize()
    Dim LstRw As Long
    Dim Rng As Range
    Dim ws As Worksheet

    Set ws = Sheets("Project Tracker")

    With ws
        LstRw = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set Rng = .Range("A2:A" & LstRw)
    End With

    ComboBox1.List = Rng.Value

End Sub

问题2>在userform2'ProjectTracksForm'中添加新轨道后，提交，然后返回到当前用户窗体'OnboardingForm'，添加的轨道应显示在“轨道”组合框的下拉列表中

当您再次激活用户窗体时，可以清除组合框，并用新列表重新填充它。

Private Sub UserForm_Activate()
    Dim LstRw As Long
    Dim Rng As Range
    Dim ws As Worksheet

    Set ws = Sheets("Project Tracker")

    With ws
        LstRw = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set Rng = .Range("A2:A" & LstRw)
    End With

    ComboBox1.Clear
    ComboBox1.List = Rng.Value

End Sub

我假设您在某处会有一个代码，可以将新项目添加到工作表中的列表中（“项目跟踪工具”），

就像是：

Private Sub CommandButton1_Click()
'THIS IS IN THE OTHER USERFORM
'add item to first blank cell in column A sheets("Project Tracker")

    Dim sh As Worksheet
    Dim LstRws As Long

    Set sh = Sheets("Project Tracker")
    With sh
        LstRws = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        .Cells(LstRws, 1) = "SomeThingNew"    'whatever you are adding to the list
    End With


End Sub

该代码将为您的工作表中的列表添加一些新内容。

当您再次显示该窗体时，新项目将在组合框中。

您可以使用Button，Combobox事件，textbox事件将项目添加到新列表中。