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事件將項目添加到新列表中。