0

我正在尝试将选定复选框的列表插入到电子表格中,在此用例中,用户最多可以选择 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

提前致谢。

4

2 回答 2

3

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

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 的解决方案。

于 2012-10-30T15:24:23.830 回答
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

于 2012-10-30T15:22:38.010 回答