excelデータをplistに変換用エクセルVBA | Codetter（こーどったー）

Sub main()

    'iOS用でエクセルファイルをplistで読み込むためのExcelVBAファイル

    'xml用変数
    Dim xmlDoc          As MSXML.DOMDocument                'XMLドキュメント
    Dim xmlPI           As IXMLDOMProcessingInstruction     'XML宣言
    Dim node(4)         As IXMLDOMNode                      '要素
    Dim plist_node(2)   As IXMLDOMNode                      '要素
    Dim attr            As MSXML.IXMLDOMAttribute           '属性
   
    'セルからのデータ取得用変数
    Dim file_name       As Variant  'File_Name
    Dim xml_des         As Variant  'XML_Description
    Dim name            As Variant  'Marker_Name
    Dim snip            As Variant  'Snippet
    Dim des             As Variant  'Marker_description
    Dim lat             As Variant  'latitude
    Dim lng             As Variant  'longitude
   
    Dim str             As String   'HTML記述
    Dim imgWidh         As String   '画像の横幅

    Dim max             As Integer  '読み込む店舗数の最大値
    Dim j               As Integer  'ForLoop Nest用
    Dim jMax            As Integer  '横方向ループ処理
   
    '変数の初期化
    max = 21
    j = 1
    jMax = 3
    imgWidth = " width=" & 3
    imgWidth02 = " width=" & 5
   
    'table用変数
    'border = " border=" & "0"
    'cellspacing = " cellspacing=" & "0"
    cellpadding = " cellpadding=" & "1"
   
   'XMLドキュメントを作成します。
    Set xmlDoc = New MSXML.DOMDocument

    'XML宣言を追加します。
    Set xmlPI = xmlDoc.appendChild(xmlDoc.createProcessingInstruction("xml", "version=""1.0"" encoding=""UTF-8"""))
      
    'XML宣言を追加します。
    Set xmlPI = xmlDoc.appendChild(xmlDoc.createProcessingInstruction("plist", "version=""1.0"""))
            
    '<dict>要素の宣言を追加します。
    Set node(1) = xmlDoc.appendChild(xmlDoc.createNode(NODE_ELEMENT, "dict", ""))
   
   
    For i = 2 To max '=125
        des01 = Cells(i, j)     'NSArrayの中身(オブジェクト) : Cell(行,列)
        str = des01
               
        If i = 2 Then
            '<key>要素を追加します。
            Set node(2) = node(1).appendChild(xmlDoc.createNode(NODE_ELEMENT, "key", ""))
             node(2).Text = Cells(1, j)
            '<array>要素を追加します。
            Set node(2) = node(1).appendChild(xmlDoc.createNode(NODE_ELEMENT, "array", ""))
        Else
        End If
   
       
        'dictionary要素ここから------------
        '<string>要素を追加します。
       
        Set node(3) = node(2).appendChild(xmlDoc.createNode(NODE_ELEMENT, "string", ""))
        node(3).Text = str
        'ここまで------------
       
        'ネストここから------------
        If i = max Then
            i = 1
           
            If j < jMax Then
                j = j + 1
            Else
                i = max
            End If
        Else
        End If
        '----------------------------------

    Next
   
    'XML
    'ドキュメントの出力
    xmlDoc.Save ("\\vmware-host\Shared Folders\デスクトップ\\popup_db.xml")
   
End Sub