Question

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

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

所以我有以下工作表：

K:\Sharedlocation\sharedfolder\workbook.xlsm

存放在旁边：

K:\Sharedlocation\sharedfolder\Export.exportedUI

我希望工作簿导入Export.exportedUI并解析它以便自定义UI。

如果你能提供帮助那就太好了。

非常感谢，

Answer 1

周末为朋友做过这样的项目。见下面的代码

'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

Answer 2

<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>

在工作簿上打开.exportedUI

2 个答案: