将VBA表单中的复选框值插入Excel电子表格

Question

我正在尝试将所选复选框的列表插入到电子表格中，在此用例中，用户最多可以选择15个项目。这将被插入到我在下面定义的某个单元格中。

我有一个包含以下名称/值的复选框：

Name         Value
==========   =====
chk_week1    1
chk_week2    2
...          ...
...          ...
chk_week15   15

例如，如果用户选择chk_week1，chk_week2，chk_week4和chk_week5，则应将其作为1,2,4,5插入单元格。

我已经包含了一张图片，以便更好地展示它：

每个复选框都有上表中列出的名称和值。这是我到目前为止使用的代码：

Private Sub btnSubmit_Click()

Dim ws As Worksheet
Dim rng1 As Range
Set ws = Worksheets("main")

' Copy the data to the database
' Get last empty cell in column A
Set rng1 = ws.Cells(Rows.Count, "a").End(xlUp)

' Having difficulty adding the code here
' rng1.Offset(1, 7) = weeks

End Sub

---

提前致谢。

Answer 1

此函数将返回您想要放入单元格的字符串。

Function CheckBoxValues() As String
    For x = 1 To 15
        If Sheets("Main").Shapes("chk_week" & x).OLEFormat.Object.Object.Value Then
            CheckBoxValues = CheckBoxValues & x & ","
        End If
    Next
    if Len(CheckBoxValue <> 0) then
       CheckBoxValues = Left(CheckBoxValues, Len(CheckBoxValues) - 1)
    end if
End Function

或者对于非循环方法，请查看Francis Dean的解决方案。

Answer 2

您可以使用一个函数来复选复选框并以所需的格式返回一个字符串（在其余的复选框上添加！）

Private Sub btnSubmit_Click()

    Dim ws As Worksheet
    Dim rng1 As Range
    Set ws = Worksheets("main")

    ' Copy the data to the database
    ' Get last empty cell in column A
    Set rng1 = ws.Cells(Rows.Count, "a").End(xlUp)

    ' Having difficulty adding the code here
    rng1.Offset(1, 7) = GetWeeks

End Sub

Private Function GetWeeks() As String

    Dim weeks As String

    'Add values to the string if condition is true
    If chk_week1.Value = True Then weeks = weeks & "1,"
    If chk_week2.Value = True Then weeks = weeks & "2,"
    If chk_week3.Value = True Then weeks = weeks & "2,"
    '...
    If chk_week14.Value = True Then weeks = weeks & "14,"
    If chk_week15.Value = True Then weeks = weeks & "15,"

    'Remove the trailing comma
    If Right(weeks, 1) = "," Then weeks = Left(weeks, Len(weeks) - 1)

    GetWeeks = weeks

End Function