在工作簿上启动.exportedUI打开

问题描述：

我创建了一个VBA工作簿，该工作簿是从包含在自定义UI中的按钮启动的。但是，工作簿存在于虚拟网络上，因此登录时自定义用户界面会丢失。我希望有人可以帮助我使用一些可以启动自定义用户界面的VBA，而不必创建一个单独的XML脚本来重现每次用户界面的自定义。原因是我没有一个XML编辑器，无法在我的工作机器上获得一个。在工作簿上启动.exportedUI打开

工作簿位置是静态的，我不需要它是可移植的，所以我很高兴解决方案包括每次打开工作簿时都从工作簿的相同位置导入.exportedUI文件。如果在工作簿关闭时删除了自定义用户界面功能，这也很有用。

所以我有以下工作：

K:\Sharedlocation\sharedfolder\workbook.xlsm

一起保存：

K:\Sharedlocation\sharedfolder\Export.exportedUI

我想工作簿导入Export.exportedUI和解析它，这样的UI定制。

如果你能帮上忙，那就太好了。

非常感谢，

答

刚刚在这样的项目上为周末的朋友工作。请参见下面的代码

'add reference Microsoft XML, v6.0 
 
Public Sub DownloadFile() 
 
    Dim objWHTTP As Object 
 
    Dim strPath As String 
 
    Dim arrData() As Byte 
 
    Dim lngFreeFile As Long 
 
    
 
    
 
    
 
    On Error Resume Next 
 
     Set objWHTTP = CreateObject("WinHTTP.WinHTTPrequest.5") 
 
     If Err.Number <> 0 Then 
 
      Set objWHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1") 
 
     End If 
 
    On Error GoTo 0 
 
    
 
    URL = "Enter your URL here" 
 
    
 
    objWHTTP.Open "GET", URL, False 
 
    objWHTTP.send 
 
    arrData = objWHTTP.responseBody 
 
    strData = StrConv(arrData, vbUnicode) 
 
    
 
    Dim xmlbook As New MSXML2.DOMDocument60 
 

 
    xmlbook.LoadXML strData 
 
    
 
    Dim datasht As Worksheet 
 
    For Each sht In ThisWorkbook.Worksheets 
 
     If sht.Name = "Data" Then 
 
      Set datasht = sht 
 
      Exit For 
 
     End If 
 
    Next sht 
 
    If datasht Is Nothing Then 
 
     Sheets.Add before:=ThisWorkbook.Sheets(1) 
 
     ThisWorkbook.Sheets(1).Name = "Data" 
 
     Set datasht = ThisWorkbook.Sheets(1) 
 
    End If 
 
    
 
    With datasht 
 
     .Cells.Clear 
 
    
 
     'Enter each date uniquely in column A 
 
     Set myTag = xmlbook.getElementsByTagName(tagName:="put your tag here") 
 
     Dim row As IXMLDOMElement 
 
     
 
     For Each row In myTag 
 
      'enter your code here 
 
     nex row 
 
    End With 
 
End Sub

嗨，真正体会到了响应。我困惑了几位： URL是指什么？ “对于myTag中的每一行'在此输入您的代码”是否指.exportedUI文档中的xml代码？否则我不确定。你介意提供一点注释吗？恐怕我的知识远低于你的水平（尽管我正在努力改进它！）。 –

我假设K：\是xml文件。该URL可以位于Web（http）或文件中。 getElementsByTagName（）创建一个可以在for循环中枚举的NodeList（）。将有助于看到XML。 – jdweng

嗨Jdweng，我已经发布了包含在exported.UI文件中的xml代码作为上面的答案。希望没关系。让我知道这是否有帮助。干杯。 –

答

<mso:cmd app="Excel" dt="1" /> 
<mso:customUI xmlns:x1="http://schemas.microsoft.com/office/2009/07/customui/macro" xmlns:mso="http://schemas.microsoft.com/office/2009/07/customui"> 
<mso:ribbon> 
    <mso:qat/> 
    <mso:tabs> 
    <mso:tab id="mso_c1.1416871F" label="CRM" insertBeforeQ="mso:TabInsert"> 
    <mso:group id="mso_c2.1416871F" label="Activity" autoScale="true"> 
    <mso:button idQ="x1:K:_MOL_Enquiry_Team_Leads_and_Pipeline_Pipeline_Manager_Test_Account.xlsm_Add_Call_0_143AA844" label="Add Call" imageMso="AutoDial" onAction="K:\MOL_Enquiry_Team\Leads and Pipeline\Pipeline Manager Test Account.xlsm!Add_Call" visible="true"/> 
    <mso:button idQ="x1:K:_MOL_Enquiry_Team_Leads_and_Pipeline_Pipeline_Manager_Test_Account.xlsm_Add_Email_1_143AA844" label="Add Email" imageMso="GoToMail" onAction="K:\MOL_Enquiry_Team\Leads and Pipeline\Pipeline Manager Test Account.xlsm!Add_Email" visible="true"/> 
    <mso:button idQ="x1:K:_MOL_Enquiry_Team_Leads_and_Pipeline_Pipeline_Manager_Test_Account.xlsm_Add_Meeting_2_143AA844" label="Add Meeting" imageMso="CondolatoryEvent" onAction="K:\MOL_Enquiry_Team\Leads and Pipeline\Pipeline Manager Test Account.xlsm!Add_Meeting" visible="true"/> 
    </mso:group> 
    <mso:group id="mso_c1.1439428A" label="Contacts" imageMso="SlideMasterClipArtPlaceholderInsert" autoScale="true"> 
    <mso:button idQ="x1:K:_MOL_Enquiry_Team_Leads_and_Pipeline_Pipeline_Manager_Test_Account.xlsm_New_Contact_3_143AA844" label="New Contact" imageMso="SlideMasterClipArtPlaceholderInsert" onAction="K:\MOL_Enquiry_Team\Leads and Pipeline\Pipeline Manager Test Account.xlsm!New_Contact" visible="true"/> 
    </mso:group> 
    </mso:tab> 
    </mso:tabs> 
</mso:ribbon> 
</mso:customUI>

看看这个网页是否有帮助：http://www.contextures.com/excelribbonaddcustomtab.html#readcode – jdweng

在工作簿上启动.exportedUI打开

相关推荐