2015-08-03 138 views
0

我創建了一個VBA工作簿,該工作簿是從包含在自定義UI中的按鈕啓動的。但是,工作簿存在於虛擬網絡上,因此登錄時自定義用戶界面會丟失。我希望有人可以幫助我使用一些可以啓動自定義用戶界面的VBA,而不必創建一個單獨的XML腳本來重現每次用戶界面的自定義。原因是我沒有一個XML編輯器,無法在我的工作機器上獲得一個。在工作簿上啓動.exportedUI打開

工作簿位置是靜態的,我不需要它是可移植的,所以我很高興解決方案包括每次打開工作簿時都從工作簿的相同位置導入.exportedUI文件。如果在工作簿關閉時刪除了自定義用戶界面功能,這也很有用。

所以我有以下工作:

K:\Sharedlocation\sharedfolder\workbook.xlsm 

一起保存:

K:\Sharedlocation\sharedfolder\Export.exportedUI 

我想工作簿導入Export.exportedUI和解析它,這樣的UI定製。

如果你能幫上忙,那就太好了。

非常感謝,

回答

0

剛剛在這樣的項目上爲週末的朋友工作。請參見下面的代碼

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

+0

嗨,真正體會到了響應。我困惑了幾位: URL是指什麼? 「對於myTag中的每一行'在此輸入您的代碼」是否指.exportedUI文檔中的xml代碼?否則我不確定。 你介意提供一點註釋嗎?恐怕我的知識遠低於你的水平(儘管我正在努力改進它!)。 –

+0

我假設K:\是xml文件。該URL可以位於Web(http)或文件中。 getElementsByTagName()創建一個可以在for循環中枚舉的NodeList()。將有助於看到XML。 – jdweng

+0

嗨Jdweng,我已經發布了包含在exported.UI文件中的xml代碼作爲上面的答案。希望沒關係。讓我知道這是否有幫助。乾杯。 –

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

看看這個網頁是否有幫助:http://www.contextures.com/excelribbonaddcustomtab.html#readcode – jdweng