header image

Makro: Naloži uporabniško določeno orodno vrstico

Združljivost MS Office 2003/ 2007 VBA MSXML.4
Prispevek / Article Uvozimo podatke o kontaktih iz Birokrata v Outlook
Opis / Summary

Makro iz XML datoteke prebere podatke o orodnih vrsticah in atribute, ki  jih določajo . Nato v MS Office programu ustvari nove orodne vrstice, skladno s prebranimi definicijami.

Function reads command bars and their attributes from XML file and creates them in any MS Office aplication.

Odvisnosti / Dependencies preddefinirana XML datoteka (glej primer spodaj)

predefined XML file (see the example bellow)

Public Sub LoadCustomToolBars()
On Error GoTo ErrorHandler

  Dim oXmlDoc As DOMDocument
  Dim oXmlRoot As IXMLDOMNode
  Dim oXmlNode As IXMLDOMNode
  Dim oCmdBar As CommandBar
  Dim aCmdBarName As String
  Dim i As Integer

  Set oXmlDoc = New DOMDocument
  oXmlDoc.Load ("C:\MiniIS\cfg\CommandBar.xml")

  Set oXmlRoot = oXmlDoc.SelectSingleNode("//CommandBars/")
  If oXmlRoot.HasChildNodes Then
    For i = 0 To oXmlRoot.ChildNodes.Length - 1
      Set oXmlNode = oXmlRoot.ChildNodes(i)
      aCmdBarName = _
        oXmlNode.Attributes.getNamedItem("Name").Text
      If CmdBarExists(aCmdBarName) Then
        Set oCmdBar = _
          Outlook.ActiveExplorer.CommandBars(aCmdBarName)
      Else
        Set oCmdBar = Outlook.ActiveExplorer.CommandBars.Add( _
          Name:=aCmdBarName, Position:=msoBarTop)
        With oCmdBar
          .RowIndex = _
            oXmlNode.Attributes.getNamedItem("RowIndex").Text
          .Visible = _
            oXmlNode.Attributes.getNamedItem("Visible").Text
        End With
        LoadControls oCmdBar, oXmlNode
      End If
    Next i
  End If

FinalHandler:
  Set oXmlRoot = Nothing
  Set oXmlNode = Nothing
  Set oXmlDoc = Nothing
  Set oCmdBar = Nothing
  Exit Sub

ErrorHandler:
  MsgBox Err.Description, vbOkOnly + vbExclamation, _
    "Napaka: " & Err.Number
  Resume FinalHandler

End Sub

'========================================================='

Private Sub LoadControls _
  (Target As Object, ByVal oXmlRoot As IXMLDOMNode)
On Error GoTo ErrorHandler

  Dim oXmlNode As IXMLDOMNode
  Dim oCtl As CommandBarControl
  Dim nCtlType As Long
  Dim i As Integer

  If oXmlRoot.HasChildNodes Then
    Set oXmlRoot = oXmlRoot.ChildNodes(0)
    For i = 0 To oXmlRoot.ChildNodes.Length - 1
      Set oXmlNode = oXmlRoot.ChildNodes(i)
      nCtlType = _
        CLng(oXmlNode.Attributes.getNamedItem("Type").Text)
      Set oCtl = Target.Controls.Add(Type:=nCtlType)
      With oCtl
        .Caption = _
          oXmlNode.Attributes.getNamedItem("Caption").Text
        .Visible = _
          oXmlNode.Attributes.getNamedItem("Visible").Text
        .TooltipText = _
          oXmlNode.Attributes.getNamedItem("ToolTip").Text
        .OnAction = _
          oXmlNode.Attributes.getNamedItem("Action").Text
        .BeginGroup = _
          oXmlNode.Attributes.getNamedItem("BeginGroup").Text
        If .Type = msoControlButton Then
          .Style = msoButtonIconAndCaption
          .FaceId = _
            oXmlNode.Attributes.getNamedItem("FaceID").Text
        End If
      End With
      If oXmlNode.HasChildNodes Then _
        LoadControls oCtl, oXmlNode
    Next i
  End If

FinalHandler:
  Set oXmlNode = Nothing
  Set oCtl = Nothing
  Exit Sub

ErrorHandler:
  MsgBox Err.Description, vbExclamation, _
    "Napaka: " & Err.Number
  Resume FinalHandler

End Sub

Primer XML datoteke / XML file example:

<CommandBars>
 <CommandBar Name="My Office Team" RowIndex="3" Visible="True">
  <Controls>
   <Control Type="10" Caption="Sample Menu" FaceID="65" Tooltip="" Action="" Visible="True">
    <Controls>
     <Control Type="1" Caption="Sample Item" FaceID="624" Tooltip="" Action="SomeMakroName" Visible="True" BeginGroup="True"/>
     ...
    </Controls>
   </Control>
  </Controls>
 </CommandBar>
 ...
</CommandBars>
  • Share/Bookmark

Pustite komentar

Tvoj odziv :

Komentiranje iz tujine je omogočeno zgolj prijavljenim uporabnikom !