VBA-組合框聯動(通過XML進行文件傳輸)

我們知道,用XML文件傳輸文件有很多好處,現在我們來做一個簡單的小程序--一個省對應它的市在列表中顯示出來

首先我們得製作一個窗體,具體佈局如下圖

首先我們得有一些基本信息,省市的基本信息

然後我們製作一個窗體,佈局如運行效果圖所示,其次我們得寫兩個函數,一個是讀取XML文件的函數,將XML文件中(市)讀取出來,一個是生成XML文件,將Excel表中的內容保存爲XML文件(一個省對應一個XML文件),對應的在後期讀取時,只要讀取對應的省的XML文件我們就可以讀取出它所有的市的內容

1.生成XML文件

寫入XML文件
Private Sub WriteToXml(proName As String, cityName As String)
    Dim xDoc As New DOMDocument60, Pro As IXMLDOMElement, City As IXMLDOMElement
    If Len(Dir(ThisWorkbook.Path & "\temp\" & proName & ".xml")) = 0 Then '不存在這樣的文件
        Set Pro = xDoc.createElement("province") '創建根節點
        xDoc.appendChild Pro '根節點加入到文檔
        Dim Pi As IXMLDOMProcessingInstruction
        Set Pi = xDoc.createProcessingInstruction("xml", "version='1.0' encoding='utf-8'")
        Call xDoc.InsertBefore(Pi, xDoc.ChildNodes(0))
      
    Else
        xDoc.Load ThisWorkbook.Path & "\temp\" & proName & ".xml" '加載文檔
        Set Pro = xDoc.DocumentElement '獲取根節點
   
    End If
        Set City = xDoc.createElement("City") '創建“市”節點
        City.Text = cityName
        Pro.appendChild City '添加到根節點。
        xDoc.Save ThisWorkbook.Path & "\temp\" & proName & ".xml" '保存XML文檔
   
End Sub

2.讀取XML文件

Private Function readfromxml(proName As String) As String()
    Dim xDoc As New DOMDocument60, Pro As IXMLDOMElement, arrcity() As String
    xDoc.Load ThisWorkbook.Path & "\temp\" & proName & ".xml" '打開XML文件
    Set Pro = xDoc.DocumentElement '獲取根節點
    ReDim arrcity(Pro.ChildNodes.Length - 1) As String '確認數組的長度
    Dim i As Integer
        For i = 0 To Pro.ChildNodes.Length - 1
        arrcity(i) = Pro.ChildNodes(i).Text
        Next i
        readfromxml = arrcity '返回函數值,返回數組
       
End Function

3.有了這兩個基本的函數我們就可以在相應的事件中編寫代碼了,完整的具體代碼如下

Option Explicit
'讀取指定省份的城市,返回數據到一個數組
Private Function readfromxml(proName As String) As String()
    Dim xDoc As New DOMDocument60, Pro As IXMLDOMElement, arrcity() As String
    xDoc.Load ThisWorkbook.Path & "\temp\" & proName & ".xml" '打開XML文件
    Set Pro = xDoc.DocumentElement '獲取根節點
   
    ReDim arrcity(Pro.ChildNodes.Length - 1) As String '確認數組的長度
    Dim i As Integer
        For i = 0 To Pro.ChildNodes.Length - 1
        arrcity(i) = Pro.ChildNodes(i).Text
        Next i
        readfromxml = arrcity '返回函數值,返回數組
       
End Function
'寫入XML文件
Private Sub WriteToXml(proName As String, cityName As String)
    Dim xDoc As New DOMDocument60, Pro As IXMLDOMElement, City As IXMLDOMElement
    If Len(Dir(ThisWorkbook.Path & "\temp\" & proName & ".xml")) = 0 Then '不存在這樣的文件
        Set Pro = xDoc.createElement("province") '創建根節點
        xDoc.appendChild Pro '根節點加入到文檔
        Dim Pi As IXMLDOMProcessingInstruction
        Set Pi = xDoc.createProcessingInstruction("xml", "version='1.0' encoding='utf-8'")
        Call xDoc.InsertBefore(Pi, xDoc.ChildNodes(0))
      
    Else
        xDoc.Load ThisWorkbook.Path & "\temp\" & proName & ".xml" '加載文檔
        Set Pro = xDoc.DocumentElement '獲取根節點
   
    End If
        Set City = xDoc.createElement("City") '創建“市”節點
        City.Text = cityName
        Pro.appendChild City '添加到根節點。
       
       
       
        xDoc.Save ThisWorkbook.Path & "\temp\" & proName & ".xml" '保存XML文檔
   
End Sub
'市列表的數據隨着省份的變動而變動
Private Sub ComboBox1_Change()
ComboBox2.List = readfromxml(ComboBox1.Text)

End Sub

Private Sub CommandButton1_Click()
Dim i As Integer
    For i = 2 To 309
        WriteToXml Cells(i, 1).Value, Cells(i, 2).Value
    Next i
End Sub

Private Sub UserForm_Initialize()'窗體加載事件
'用字典來集合省名稱
Dim d As Object, i As Integer
Set d = CreateObject("scripting.dictionary")
For i = 2 To 309
    d(Cells(i, 1).Value) = ""
Next i

ComboBox1.List = d.keys

End Sub

最後我們來看一下生成的XML文件

打開其中一個文件,會發現它是用子節點進行保存的



發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章