Question

如何创建以下循环。

基本上第一个循环列表是selectStatus，selectSite，这些是工作表上的复选框。（下面的代码只包含两个，但完整的宏有大约60个循环）

第二个循环将是值＆＃34;标题1＆＃34;，＆＃34;标题2＆＃34;等等，因此它们将循环并一起更改。第一个是复选框名称，第二个是相应的SQL头，我想在最后创建一个字符串。

    Sub TEST2()

    If Sheets("controlSheet").selectStatus.Value = True Then
    a = "Header 1, "
    Else
    a = ""
    End If

    If Sheets("controlSheet").selectSite.Value = True Then
    a = a + "Header 2, "
    Else
    a = a + ""
    End If

    End Sub

Answer 1

这应该处理ActiveX复选框。

注意：这要求您的复选框已正确编入索引（即第一个一个索引将对应“标题1”，第二个对应“标题2”，带有“Header n ”等的 n 。如果它们出现故障，您需要额外的逻辑来控制它（如果是这种情况，请参阅the other answer for a good solution。）

Option Explicit
Sub LoopActiveXCheckBoxes()

Dim ws As Worksheet
Dim obj As OLEObject
Dim cb As CheckBox
Dim i As Long
Dim a As String

Set ws = Sheets("controlSheet")
For Each obj In ws.OLEObjects
    If TypeName(obj.Object) = "CheckBox" Then
        i = i + 1
        If obj.Object.Value = True Then
            a = a & "Header " & CStr(i) & ","
        End If
    End If
Next
If Len(a) > 0 Then a = Left(a, Len(a) - 1)

End Sub

对于表单控件复选框，这可以工作，但我很确定你使用的是ActiveX。

Sub LoopCheckBoxes()

Dim ws As Worksheet
Dim cb As CheckBox
Dim i As Long
Dim a As String

Set ws = Sheets("controlSheet")
For Each cb In ws.CheckBoxes
    i = i + 1
    If cb.Value = 1 Then
        a = a & "Header " & CStr(i) & ","
    End If
Next
If Len(a) > 0 Then a = Left(a, Len(a) - 1)

End Sub

Answer 2

这是一个标题，您可以在其中创建一个对象来保存控件名称和标题名称之间的映射列表。让我知道任何问题。

Dim oDictHeaders As Object

Function GetHeaders() As Object
    If oDictHeaders Is Nothing Then
        Set oDictHeaders = CreateObject("Scripting.Dictionary")

        oDictHeaders("SelectSite") = "Header 1"
        oDictHeaders("SelectStatus") = "Header 2"
        oDictHeaders("SelectOther") = "Header 3"
    End If

    Set GetHeaders = oDictHeaders
End Function


Function GetListOfHeaders() As String
    Dim sOutput As String
    Dim oDict As Object
    Dim ctl As Object

    sOutput = ""

    Set oDict = GetHeaders()

    For Each ctl In Sheet1.OLEObjects
    Debug.Print TypeName(ctl.Object)
        If TypeName(ctl.Object) = "CheckBox" Then
            If ctl.Object.Value = True Then
                sOutput = sOutput & ", " & oDict(ctl.Name)
            End If
        End If
    Next ctl

    GetListOfHeaders = Mid(sOutput, 2)
End Function

Sub Test()
    MsgBox (GetListOfHeaders())
End Sub

循环选择工作表上的复选框

2 个答案: