将userform复选框选择保存到数组(以在userform上复制)

时间:2016-01-25 17:01:35

标签: arrays excel excel-vba userform vba

如何识别用户表单中框架中的所有选中复选框,并将它们分配给一个数组,以便我可以/两者:复制一个或多个其他框架中的选定复选框。使用数组填写电子表格单元格?

这是一个由两部分组成的问题,但我认为它们是相辅相成的(我不确定)。我有一个包含多个框架的用户窗体,每个窗口内都有很多复选框(SS) - 我对它们都有一个标准的命名约定(在底部解释)。

我需要确定选择了哪些复选框(以及组合框中的选项),以便将所有这些复选框放入电子表格中。如果他/她想要,我还需要用户将所有选中的复选框(以及组合框中的选择)从一帧复制到一到三个其他帧的选项。我有一个"复制"初始化短用户窗体以选择要从中复制哪个帧以及要复制到哪个帧的按钮。 (例如:能够将" Alpha Antennas"帧中的所有选项复制到一个或多个" Beta天线"帧," Gamma Antennas"帧, " Delta Antennas"框架。)一旦我得到它,真的坚持主要形式的做什么?我认为一个阵列将为我提供我需要的两个功能(将一个帧复制到另一个帧并填写电子表格) - 但我不知道下一步。有什么帮助吗?

一些代码/命名/ SS:

加载主窗体的命令按钮

Sub CreateADS()
Dim oneForm As Object 
'==========================================================
'On Error GoTo ErrHandler 'Trying to catch errors - will input more down there, later

    ADSinputform.Show
    For Each oneForm In UserForms
        Unload oneForm
        'Unload ADSinputform
    Next oneForm
End Sub

主要用户形式开始代码

    Dim myCheckBoxes() As clsUFCheckBox

    Private Sub UserForm_Activate()
        '======================================================
        'couple pre-initialization things here
        '======================================================
    End Sub

    Private Sub UserForm_Initialize()
    Dim chBox As Control
    Dim comboBox As Control
    Dim arrFreq() As String
    Dim i As Long
    Dim siteName As String
    Dim ctrl As Object, pointer As Long

    ReDim myCheckBoxes(1 To Me.Controls.Count)
        For Each ctrl In Me.Controls
            If TypeName(ctrl) = "CheckBox" Then
                pointer = pointer + 1
                Set myCheckBoxes(pointer) = New clsUFCheckBox
                Set myCheckBoxes(pointer).aCheckBox = ctrl
            End If
        Next ctrl

    ReDim Preserve myCheckBoxes(1 To pointer)

        'Use the Split function to create two zero based one dimensional arrays.
        arrFreq = Split("Unused|GSM,850|GSM,1900|UMTS,850|UMTS,1900|CDMA,850|LTE,700|LTE,850|LTE,1900|LTE,2100|LTE,2300", "|")
        For Each comboBox In ADSinputform.Controls
            If TypeOf comboBox Is MSForms.comboBox Then
                For i = 0 To UBound(arrFreq)
                    'Use .List property to write array data to all the comboBoxes
                    comboBox.List = arrFreq
                Next i
            End If
        Next

        MsgBox "This pops up at the end of initialization"
    End Sub

Private Sub cmdCopy_Click()
Dim chkBox As Control
Dim cmbBox As Control
Dim frmSource As MSForms.Frame
'Dim frmSource As String
Dim valSectCopy1 As String 'to validate that a sector is filled in
Dim valSectCopy2 As String 'to validate that an antenna is filled in
Dim valPortCopy As String 'to validate that a port is filled in

Set frmSource = SectorsFrame
valSectCopy1 = ""
valSectCopy2 = ""
valPortCopy = ""


    For Each chkBox In frmSource.Controls 'Sector-level frame
        If TypeName(chkBox) = "CheckBox" And chkBox.Value = True Then
            valSectCopy1 = chkBox.Tag
            valSectCopy2 = valSectCopy1
            Set frmSource = Controls(valSectCopy1)
            Exit For
        End If
    Next chkBox
    If valSectCopy1 <> "" Then
        For Each chkBox In frmSource.Controls 'Antenna-level frame
            If TypeName(chkBox) = "CheckBox" And chkBox.Value = True Then
                valSectCopy2 = chkBox.Tag
                valPortCopy = valSectCopy2
                Set frmSource = Controls(valSectCopy2)
                Exit For
            End If
        Next chkBox
    Else
        GoTo NoSource
    End If
    If valSectCopy2 <> valSectCopy1 Then
        For Each cmbBox In frmSource.Controls 'Port-level frame
            If TypeName(cmbBox) = "ComboBox" And cmbBox.Value <> "Frequency" Then
                valPortCopy = cmbBox.Value
                Exit For
            End If
        Next cmbBox
    Else
        GoTo NoSource
    End If
    If valSectCopy2 = valPortCopy Then
        GoTo NoSource
    End If



    CopySector.Show
        If CopySector.destSectCopy <> "" And CopySector.srcSectCopy <> "" Then
            MsgBox "Copying the " & CopySector.srcSectCopy & _
                " sector to " & CopySector.destSectCopy & " sector(s)."
            Unload CopySector
            Exit Sub
        Else
            Exit Sub
        End If

NoSource:
    MsgBox "You have not filled in a sector to copy." & vbCrLf & _
        "Please fill out sector info for at least one sector and try again."
    Exit Sub


    End Sub

问卷用户表单代码

Public srcSectCopy As String
Public destSectCopy As String


Private Sub cmdCopy_Click()
Dim optBtn As Control
Dim chkBox As Control

srcSectCopy = ""
destSectCopy = ""

    For Each optBtn In Me.Controls
        If TypeName(optBtn) = "OptionButton" Then
            If optBtn.Value = True Then
                srcSectCopy = optBtn.Tag
            End If
        End If
    Next optBtn

    If srcSectCopy = "" Then
        MsgBox "You have not selected a sector to copy." & vbCrLf & _
            "Please select a sector to copy from and try again."
        Exit Sub
    End If

    For Each chkBox In Me.Controls
        If TypeName(chkBox) = "CheckBox" Then
            If chkBox.Value = True Then
                If destSectCopy = "" Then
                    destSectCopy = chkBox.Tag
                Else
                    destSectCopy = destSectCopy & ", " & chkBox.Tag
                End If
            End If
        End If
    Next chkBox

    If destSectCopy = "" Then
        MsgBox "You have not selected any sectors to copy to." & vbCrLf & _
            "Please select one or more sectors to be duplicated and try again."
        Exit Sub
    End If

    Msg = "this will copy the " & srcSectCopy & _
        " sector to " & destSectCopy & " sector(s)." & vbCrLf & _
        "Do you want to continue with the operation?"
        Ans = MsgBox(Msg, vbQuestion + vbYesNo)
        Select Case Ans
            Case vbYes
                Me.Hide
            Case vbNo
                Exit Sub
          End Select


End Sub

Private Sub UserForm_Initialize()

End Sub



Private Sub AlphaSect_OptBtn_Change()

    Select Case (AlphaSect_OptBtn.Value)
        Case True:  AlphaSect_CheckBox.Enabled = False
        AlphaSect_CheckBox.Value = False
        Case False: AlphaSect_CheckBox.Enabled = True
    End Select

End Sub

Private Sub BetaSect_OptBtn_Change()

    Select Case (BetaSect_OptBtn.Value)
        Case True:  BetaSect_CheckBox.Enabled = False
        BetaSect_CheckBox.Value = False
        Case False: BetaSect_CheckBox.Enabled = True
    End Select

End Sub

Private Sub GammaSect_OptBtn_Change()

    Select Case (GammaSect_OptBtn.Value)
        Case True:  GammaSect_CheckBox.Enabled = False
        GammaSect_CheckBox.Value = False
        Case False: GammaSect_CheckBox.Enabled = True
    End Select

End Sub

Private Sub DeltaSect_OptBtn_Change()

    Select Case (DeltaSect_OptBtn.Value)
        Case True:  DeltaSect_CheckBox.Enabled = False
        DeltaSect_CheckBox.Value = False
        Case False: DeltaSect_CheckBox.Enabled = True
    End Select

End Sub


Private Sub cmdCancel_Click()

  Msg = "Are you sure you want to cancel and exit without copying?"
        Ans = MsgBox(Msg, vbQuestion + vbYesNo)
        Select Case Ans
            Case vbYes
                Me.Hide
                Unload Me
            Case vbNo
                Exit Sub
          End Select

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  If CloseMode = vbFormControlMenu Then
    ' user clicked the X button
    ' cancel unloading the form, use close button procedure instead
    Cancel = True
    cmdCancel_Click
  End If
End Sub

以下课程

Option Explicit
Public WithEvents aCheckBox As MSForms.CheckBox
Private Sub aCheckBox_Click()
Dim chBox As Control
Dim chBoxTag As String

chBoxTag = aCheckBox.Tag

If Right(aCheckBox.Parent.Name, 10) = "Port_Frame" Then
    If aCheckBox.Value = True Then ADSinputform.Controls(chBoxTag).Enabled = True
    If aCheckBox.Value = False Then
        ADSinputform.Controls(chBoxTag).Enabled = False
    End If
Else
    If aCheckBox.Value = True Then ADSinputform.Controls(chBoxTag).Visible = True
    If aCheckBox.Value = False Then
        ADSinputform.Controls(chBoxTag).Visible = False
        For Each chBox In ADSinputform.Controls(chBoxTag).Controls
            If TypeOf chBox Is MSForms.CheckBox Then chBox.Value = False
        Next
    End If
End If
End Sub

我不确定这可以做到,而且我不确定从哪里开始。我知道我可以遍历所有控件并读取状态或组合框选择,但之后该怎么办?

命名: 框架:&#34; AlphaSect_Frame&#34;,&#34; BetaSect_Frame&#34;,&#34; GammaSect_Frame&#34;

第一级复选框:&#34; A1Checkbox&#34;,&#34; A2Checkbox&#34;,&#34; A3Checkbox&#34; ...&#34; B1Checkbox&#34;,&#34; B2Checkbox&#34; ...&#34; C1Checkbox&#34;,&#34; C2Checkbox&#34;

二级复选框:&#34; A1P1Checkbox&#34;,&#34; A1P2Checkbox&#34;,&#34; A2P1Checkbox&#34;,&#34; A2P2Checkbox&#34; ...&#34; B1P1Checkbox&#34;,&#34; B1P2Checkbox&#34;,&#34; B2P1Checkbox&#34;,&#34; B2P2Checkbox&#34; ...&#34; C1P1Checkbox&#34;,&#34; C1P2Checkbox&#34 ;,&#34; C2P1Checkbox&#34;,&#34; C2P2Checkbox&#34;

Userform屏幕截图

Main Userform

Copy questionnaire userform

1 个答案:

答案 0 :(得分:1)

以下是一个包​​含两个框架的表单的简单示例,每个框架都有两个复选框:

Dim f1 As Frame, f2 As Frame, c As Control

Set f1 = Me.Frame1 'has checkboxes "f1cb1", "f1cb2"
Set f2 = Me.Frame2 'has checkboxes "f2cb1", "f2cb2"

'loop over all controls in Frame 1
For Each c In f1.Controls
    If TypeName(c) = "CheckBox" Then
        'set the value of the corresponding control in the other fame
        Me.Controls(Replace(c.Name, "f1", "f2")).Value = c.Value
    End If
Next c