写入custom.xml步骤：

• 从Excel中读取数据并转换为xml格式的文本

• 然后转换编码

• 使用类模块CPKZip的功能，将custom.xml写入(CPKZip的写入功能下次介绍)

这里需要注意的是，如果某个Office文件没有custom.xml，除了要写入custom.xml之外，还必须在_rels/.rels文件后面，增加一条Relationship：

'写入customUI.xmlSub WriteCustomUI()    Dim arr()    Dim sXML As String        arr = Range("A1").CurrentRegion.Value    '单元格内容转换为xml文本    sXML = Array2XMLString(arr)    If VBA.Len(sXML) = 0 Then        MsgBox "请在单元格中设置customUI"        Exit Sub    End If    Dim bucs2() As Byte    bucs2 = sXML        '转换编码    Dim bUTF8() As Byte    Dim ret As String    ret = ToUTF8(bucs2, bUTF8)    If VBA.Len(ret) Then        MsgBox "编码转换出错：" & vbNewLine & ret        Exit Sub    End If        '检查是否设置了目标文件    If VBA.Len(FileName) = 0 Then        FileName = SelectFile()        If VBA.Len(FileName) = 0 Then Exit Sub    End If        '备份文件    If bBakFile Then        VBA.FileCopy FileName, FileName & ".备份" & VBA.Format(VBA.Now(), "yyyymmddhhmmss")    End If        Dim zip As CPKZip    Set zip = NewCPKZip()    '解析文件    ret = zip.Parse(FileName)    If VBA.Len(ret) Then        MsgBox ret        Exit Sub    End If        '判断是否存在CUSTOMUI_NAME，不存在的情况下还要更新rel    Dim fs() As String    fs = zip.Files()    Dim i As Long    For i = 0 To UBound(fs)        If fs(i) = CUSTOMUI_NAME Then            Exit For        End If    Next        Dim b() As Byte '记录_rels/.rels    If i = UBound(fs) + 1 Then        '添加rel           ret = zip.UnZipFile("_rels/.rels", b)        If VBA.Len(ret) Then            MsgBox ret            Exit Sub        End If                ret = FromUTF8(b, bucs2)        If VBA.Len(ret) Then            MsgBox ret            Exit Sub        End If        '将最后的替换为Id="VBAPKZIP" Type="http://schemas.microsoft.com/office/2006/relationships/ui/extensibility" Target="customUI/customUI.xml"/>        Dim str As String        str = bucs2        str = VBA.Left$(str, VBA.Len(str) - VBA.Len(""))        str = str & ""                bucs2 = str                ret = ToUTF8(bucs2, b)        If VBA.Len(ret) Then            MsgBox ret            Exit Sub        End If                ret = zip.AddFile("_rels/.rels", b)        If VBA.Len(ret) Then            MsgBox ret            Exit Sub        End If    End If        '添加customUI.xml    ret = zip.AddFile(CUSTOMUI_NAME, bUTF8)    If VBA.Len(ret) Then        MsgBox ret        Exit Sub    End If        Set zip = NothingEnd Sub