如何保存checkbox 的状态

[VB小白123]

日期3月9日时选中check1，如何保存check1的状态，在下次选择3月9日时 check1还是选中转态

[无·法]

将状态记录到文件或者注册表，下次使用提取出来设置到界面，原理就是这样，代码自己写

[VB小白123]

引用 2 楼 caozhy 的回复:

msdn里搜索SaveSettings

大神能加个QQ吗

[VB小白123]

引用 3 楼 milaoshu1020 的回复:

DEMO界面:


DEMO代码:
需要添加引用"Microsoft Scripting Runtime".

Option Explicit

Private mdctChecks As New Dictionary

Private Sub UpdateMemory(ByVal chk As CheckBox)
    mdctChecks.Item(chk.Name).Item(DTPicker1.Value) = chk.Value
End Sub

Private Sub Command1_Click()
    UpdateMemory Check1
    UpdateMemory Check2
End Sub

Private Sub Command2_Click()
    UpdateMemory Check3
    UpdateMemory Check4
End Sub

Private Sub Command3_Click()
    UpdateMemory Check5
    UpdateMemory Check6
End Sub

Private Sub UpdateScreen()
    Dim ctrl As Control
    For Each ctrl In Me.Controls
        If TypeOf ctrl Is CheckBox Then
            If mdctChecks.Item(ctrl.Name).Exists(DTPicker1.Value) Then
                ctrl.Value = mdctChecks.Item(ctrl.Name).Item(DTPicker1.Value)
            Else
                ctrl.Value = vbUnchecked
            End If
        End If
    Next
End Sub

Private Sub DTPicker1_Change()
    UpdateScreen
End Sub

Private Sub Form_Load()
    Dim ctrl As Control
    For Each ctrl In Me.Controls
        If TypeOf ctrl Is CheckBox Then
            mdctChecks.Add ctrl.Name, New Dictionary
        End If
    Next
    
    Dim varKey As Variant
    For Each varKey In mdctChecks
        Dim strData As String
        strData = GetSetting(App.EXEName, "Section", varKey, "")
        
        Dim arrData() As String
        arrData = Split(strData, ",")
        
        Dim i As Integer
        For i = LBound(arrData) To UBound(arrData)
            Dim arrData2() As String
            arrData2 = Split(arrData(i), "=")
            
            mdctChecks.Item(varKey).Item(CDate(arrData2(0))) = arrData2(1)
         Next
    Next
    
    UpdateScreen
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim varKey As Variant
    For Each varKey In mdctChecks
        Dim strData As String
        strData = ""
        
        Dim varKey2 As Variant
        For Each varKey2 In mdctChecks.Item(varKey)
            strData = strData & varKey2 & "=" & mdctChecks.Item(varKey).Item(varKey2) & ","
        Next
        
        If Right(strData, 1) = "," Then
            strData = Left(strData, Len(strData) - 1)
        End If
        
        SaveSetting App.EXEName, "Section", varKey, strData
    Next
End Sub

DEMO下载:
链接：https://pan.baidu.com/s/1E7HybFLe7SUfgSRyNFoJpg
提取码：ylem

大神能加个QQ吗

[milaoshu1020]

DEMO界面:


DEMO代码:
需要添加引用"Microsoft Scripting Runtime".

Option Explicit

Private mdctChecks As New Dictionary

Private Sub UpdateMemory(ByVal chk As CheckBox)
    mdctChecks.Item(chk.Name).Item(DTPicker1.Value) = chk.Value
End Sub

Private Sub Command1_Click()
    UpdateMemory Check1
    UpdateMemory Check2
End Sub

Private Sub Command2_Click()
    UpdateMemory Check3
    UpdateMemory Check4
End Sub

Private Sub Command3_Click()
    UpdateMemory Check5
    UpdateMemory Check6
End Sub

Private Sub UpdateScreen()
    Dim ctrl As Control
    For Each ctrl In Me.Controls
        If TypeOf ctrl Is CheckBox Then
            If mdctChecks.Item(ctrl.Name).Exists(DTPicker1.Value) Then
                ctrl.Value = mdctChecks.Item(ctrl.Name).Item(DTPicker1.Value)
            Else
                ctrl.Value = vbUnchecked
            End If
        End If
    Next
End Sub

Private Sub DTPicker1_Change()
    UpdateScreen
End Sub

Private Sub Form_Load()
    Dim ctrl As Control
    For Each ctrl In Me.Controls
        If TypeOf ctrl Is CheckBox Then
            mdctChecks.Add ctrl.Name, New Dictionary
        End If
    Next
    
    Dim varKey As Variant
    For Each varKey In mdctChecks
        Dim strData As String
        strData = GetSetting(App.EXEName, "Section", varKey, "")
        
        Dim arrData() As String
        arrData = Split(strData, ",")
        
        Dim i As Integer
        For i = LBound(arrData) To UBound(arrData)
            Dim arrData2() As String
            arrData2 = Split(arrData(i), "=")
            
            mdctChecks.Item(varKey).Item(CDate(arrData2(0))) = arrData2(1)
         Next
    Next
    
    UpdateScreen
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim varKey As Variant
    For Each varKey In mdctChecks
        Dim strData As String
        strData = ""
        
        Dim varKey2 As Variant
        For Each varKey2 In mdctChecks.Item(varKey)
            strData = strData & varKey2 & "=" & mdctChecks.Item(varKey).Item(varKey2) & ","
        Next
        
        If Right(strData, 1) = "," Then
            strData = Left(strData, Len(strData) - 1)
        End If
        
        SaveSetting App.EXEName, "Section", varKey, strData
    Next
End Sub

DEMO下载:
链接：https://pan.baidu.com/s/1E7HybFLe7SUfgSRyNFoJpg
提取码：ylem

[threenewbee]

msdn里搜索SaveSettings

[milaoshu1020]

留下你的邮箱,我把QQ发给你.

[VB小白123]

引用 6 楼 milaoshu1020 的回复:

留下你的邮箱,我把QQ发给你.

[e-mail]

[milaoshu1020]

这是保存成XML的代码:

Option Explicit

Private mdctChecks As New Dictionary

Private Sub UpdateMemory(ByVal chk As CheckBox)
    mdctChecks.Item(chk.Name).Item(DTPicker1.Value) = chk.Value
End Sub

Private Sub Command1_Click()
    UpdateMemory Check1
    UpdateMemory Check2
End Sub

Private Sub Command2_Click()
    UpdateMemory Check3
    UpdateMemory Check4
End Sub

Private Sub Command3_Click()
    UpdateMemory Check5
    UpdateMemory Check6
End Sub

Private Sub UpdateScreen()
    Dim ctrl As Control
    For Each ctrl In Me.Controls
        If TypeOf ctrl Is CheckBox Then
            If mdctChecks.Item(ctrl.Name).Exists(DTPicker1.Value) Then
                ctrl.Value = mdctChecks.Item(ctrl.Name).Item(DTPicker1.Value)
            Else
                ctrl.Value = vbUnchecked
            End If
        End If
    Next
End Sub

Private Sub DTPicker1_Change()
    UpdateScreen
End Sub

Private Property Get XmlPath() As String
    XmlPath = App.Path & "\" & App.EXEName & ".xml" '这里可以改成网络路径.
End Property

Private Sub Form_Load()
    Dim ctrl As Control
    For Each ctrl In Me.Controls
        If TypeOf ctrl Is CheckBox Then
            mdctChecks.Add ctrl.Name, New Dictionary
        End If
    Next
    
    Dim objXmlDoc As New DOMDocument
    objXmlDoc.Load XmlPath
    
    Dim varKey As Variant
    For Each varKey In mdctChecks
        Dim objElem As IXMLDOMElement
        Set objElem = objXmlDoc.selectSingleNode("/checks/check[@name='" & varKey & "']")
        
        If Not objElem Is Nothing Then
            Dim objElem2 As IXMLDOMElement
            For Each objElem2 In objElem.childNodes
                mdctChecks.Item(varKey).Item(CDate(objElem2.getAttribute("date"))) = objElem2.getAttribute("value")
            Next
        End If
    Next
    
    UpdateScreen
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim objXmlDoc As New DOMDocument
    objXmlDoc.appendChild objXmlDoc.createProcessingInstruction("xml", "version=""1.0""")
    Set objXmlDoc.documentElement = objXmlDoc.createElement("checks")

    Dim varKey As Variant
    For Each varKey In mdctChecks
        Dim objElem As IXMLDOMElement
        Set objElem = objXmlDoc.createElement("check")
        objElem.setAttribute "name", varKey
        objXmlDoc.documentElement.appendChild objElem
    
        Dim strData As String
        strData = ""
        
        Dim varKey2 As Variant
        For Each varKey2 In mdctChecks.Item(varKey)
            Dim objElem2 As IXMLDOMElement
            Set objElem2 = objXmlDoc.createElement("data")
            objElem2.setAttribute "date", varKey2
            objElem2.setAttribute "value", mdctChecks.Item(varKey).Item(varKey2)
            objElem.appendChild objElem2
        Next
        
        objXmlDoc.save XmlPath
    Next
End Sub