942 lines
32 KiB
VB.net
942 lines
32 KiB
VB.net
'TODO: Follow these steps to enable the Ribbon (XML) item:
|
|
|
|
'1: Copy the following code block into the ThisAddin, ThisWorkbook, or ThisDocument class.
|
|
|
|
'Protected Overrides Function CreateRibbonExtensibilityObject() As Microsoft.Office.Core.IRibbonExtensibility
|
|
' Return New Ribbon1()
|
|
'End Function
|
|
|
|
'2. Create callback methods in the "Ribbon Callbacks" region of this class to handle user
|
|
' actions, such as clicking a button. Note: if you have exported this Ribbon from the
|
|
' Ribbon designer, move your code from the event handlers to the callback methods and
|
|
' modify the code to work with the Ribbon extensibility (RibbonX) programming model.
|
|
|
|
'3. Assign attributes to the control tags in the Ribbon XML file to identify the appropriate callback methods in your code.
|
|
|
|
'For more information, see the Ribbon XML documentation in the Visual Studio Tools for Office Help.
|
|
|
|
Imports Microsoft.Office.Core
|
|
Imports Word = Microsoft.Office.Interop.Word
|
|
|
|
<Runtime.InteropServices.ComVisible(True)>
|
|
Public Class Ribbon1
|
|
Implements Office.IRibbonExtensibility
|
|
|
|
Private ribbon As Office.IRibbonUI
|
|
'Private App As Word.Application
|
|
'Public Path2Setup As String
|
|
Private MyFormat As String
|
|
|
|
Public Sub New()
|
|
End Sub
|
|
|
|
Public Function GetCustomUI(ByVal ribbonID As String) As String Implements Office.IRibbonExtensibility.GetCustomUI
|
|
Return GetResourceText("W2PAddIn.Ribbon1.xml")
|
|
End Function
|
|
|
|
#Region "Ribbon Callbacks"
|
|
'Create callback methods here. For more information about adding callback methods, visit https://go.microsoft.com/fwlink/?LinkID=271226
|
|
Public Sub Ribbon_Load(ByVal ribbonUI As Office.IRibbonUI)
|
|
Me.ribbon = ribbonUI
|
|
End Sub
|
|
|
|
Public Sub BtnSearch(ByVal ctl As IRibbonControl)
|
|
'perform initial search for document elements
|
|
Dim sMsg As String
|
|
|
|
sMsg = "This action will search for procedure elements and mark them with Comments. This may take some time."
|
|
sMsg = sMsg & vbCrLf & "Do you wish to continue?"
|
|
|
|
If MsgBox(sMsg, vbOKCancel + vbQuestion + vbDefaultButton1, "Search For Procedure Elements") = vbOK Then
|
|
'FindItems
|
|
PreSearchCleanup
|
|
FindShapes
|
|
FindSteps
|
|
FindStuff
|
|
'FindShapes
|
|
'FindSections
|
|
App.ActiveDocument.Paragraphs(1).Range.Select()
|
|
App.StatusBar = "Seach - Done"
|
|
|
|
MsgBox("Search Complete", vbOKOnly, "Search For Procedure Elements")
|
|
|
|
End If
|
|
|
|
End Sub
|
|
|
|
|
|
Public Sub BtnDecrease(ByVal ctl As IRibbonControl)
|
|
Dim rng As Word.Range
|
|
Dim rCmt As Word.Range
|
|
Dim para As Word.Paragraph
|
|
Dim sAuthor As String
|
|
Dim vLevel As Object
|
|
|
|
rng = App.Selection.Range
|
|
For Each para In rng.Paragraphs
|
|
rCmt = GetComment(para.Range)
|
|
If Not rCmt Is Nothing Then
|
|
sAuthor = rCmt.Comments(1).Author
|
|
If sAuthor Like "STEP*" Then
|
|
vLevel = Mid(sAuthor, 6, 1)
|
|
If vLevel > 2 Then
|
|
ThisLevel = vLevel - 1
|
|
Else
|
|
ThisLevel = 2
|
|
End If
|
|
rCmt.Comments(1).Author = "STEP " & ThisLevel
|
|
End If
|
|
End If
|
|
Next para
|
|
rng.Select()
|
|
|
|
End Sub
|
|
|
|
Public Sub BtnIgnore(ByVal ctl As IRibbonControl)
|
|
'RemoveComments
|
|
InsertComment("IGNORE")
|
|
End Sub
|
|
|
|
Public Sub BtnIncrease(ByVal ctl As IRibbonControl)
|
|
Dim rng As Word.Range
|
|
Dim rCmt As Word.Range
|
|
Dim para As Word.Paragraph
|
|
Dim sAuthor As String
|
|
Dim vLevel As Object
|
|
|
|
rng = App.Selection.Range
|
|
For Each para In rng.Paragraphs
|
|
rCmt = GetComment(para.Range)
|
|
If Not rCmt Is Nothing Then
|
|
sAuthor = rCmt.Comments(1).Author
|
|
If sAuthor Like "STEP*" Then
|
|
vLevel = Mid(sAuthor, 6, 1)
|
|
If vLevel < 9 Then
|
|
ThisLevel = vLevel + 1
|
|
Else
|
|
ThisLevel = 9
|
|
End If
|
|
rCmt.Comments(1).Author = "STEP " & ThisLevel
|
|
End If
|
|
End If
|
|
Next para
|
|
rng.Select()
|
|
|
|
End Sub
|
|
|
|
Public Sub BtnNote(ByVal ctl As IRibbonControl)
|
|
'mark selected text as a note
|
|
'RemoveComments
|
|
InsertComment("NOTE")
|
|
End Sub
|
|
|
|
Public Sub BtnNext(ByVal ctl As IRibbonControl)
|
|
If MoveNext = True Then
|
|
GetSection
|
|
If InStr(LCase(ThisSection.Type), "word") + App.Selection.Comments.Count = 0 Then
|
|
WhatIsThis
|
|
End If
|
|
End If
|
|
End Sub
|
|
|
|
Public Sub BtnPrevious(ByVal ctl As IRibbonControl)
|
|
If MovePrevious = True Then
|
|
GetSection
|
|
If InStr(LCase(ThisSection.Type), "word") + App.Selection.Comments.Count = 0 Then
|
|
WhatIsThis
|
|
End If
|
|
End If
|
|
End Sub
|
|
|
|
Public Sub BtnCaution(ByVal ctl As IRibbonControl)
|
|
'mark selected text as a note
|
|
'RemoveComments
|
|
InsertComment("CAUTION")
|
|
End Sub
|
|
|
|
Public Sub BtnTable(ByVal ctl As IRibbonControl)
|
|
'mark selected table as a table
|
|
App.Selection.Tables(1).Select()
|
|
'RemoveComments
|
|
InsertComment("TABLE")
|
|
End Sub
|
|
|
|
Public Sub BtnTitle(ByVal ctl As IRibbonControl)
|
|
'mark selected text as a section title
|
|
'RemoveComments
|
|
InsertComment("SECTION TITLE")
|
|
End Sub
|
|
|
|
Public Sub BtnFigure(ByVal ctl As IRibbonControl)
|
|
'mark selected shape as a figure
|
|
App.Selection.InlineShapes(1).Select()
|
|
'RemoveComments
|
|
InsertComment("FIGURE")
|
|
End Sub
|
|
|
|
Public Sub BtnDelete(ByVal ctl As IRibbonControl)
|
|
'remove all comments from the current selection
|
|
RemoveComments(True)
|
|
End Sub
|
|
|
|
Public Sub BtnFindSections(ByVal ctl As IRibbonControl)
|
|
FindSections
|
|
App.StatusBar = "Find Sections - Done"
|
|
If Not Me.ribbon Is Nothing Then
|
|
Me.ribbon.Invalidate()
|
|
End If
|
|
End Sub
|
|
|
|
Public Sub btnMergeSections(ByVal ctl As IRibbonControl)
|
|
MergeSections
|
|
App.StatusBar = "Merge Sections - Done"
|
|
If Not Me.ribbon Is Nothing Then
|
|
Me.ribbon.Invalidate()
|
|
End If
|
|
End Sub
|
|
|
|
Public Sub BtnSection(ByVal ctl As IRibbonControl)
|
|
'RemoveComments
|
|
'InsertComment "SECTION", ThisSection.Name & vbCrLf & ThisSection.Description & vbCrLf & ThisSection.Type
|
|
If Len(App.Selection.Text) < 2 Then
|
|
App.Selection.InsertBefore("SECTION")
|
|
End If
|
|
FlagSection(ThisSection)
|
|
If Not Me.ribbon Is Nothing Then
|
|
Me.ribbon.Invalidate()
|
|
End If
|
|
End Sub
|
|
|
|
Public Sub BtnSecMoveUp(ByVal ctl As IRibbonControl)
|
|
MoveComment("SECTION", "Up")
|
|
End Sub
|
|
|
|
Public Sub BtnSecMoveDown(ByVal ctl As IRibbonControl)
|
|
MoveComment("SECTION", "Down")
|
|
End Sub
|
|
|
|
Public Sub BtnSecGoNext(ByVal ctl As IRibbonControl)
|
|
App.Selection.GoTo(What:=Word.WdGoToItem.wdGoToComment, Which:=Word.WdGoToDirection.wdGoToNext, Name:="SECTION")
|
|
End Sub
|
|
|
|
Public Sub BtnSecGoPrevious(ByVal ctl As IRibbonControl)
|
|
App.Selection.GoTo(What:=Word.WdGoToItem.wdGoToComment, Which:=Word.WdGoToDirection.wdGoToPrevious, Name:="SECTION")
|
|
End Sub
|
|
|
|
Public Sub BtnXMLMake(ByVal ctl As IRibbonControl)
|
|
MakePromsXML
|
|
End Sub
|
|
|
|
Public Sub BtnXMLView(ByVal ctl As IRibbonControl)
|
|
frmXML.Show
|
|
End Sub
|
|
|
|
Public Sub BtnPXML(ByVal ctl As IRibbonControl)
|
|
MakeImportFile
|
|
End Sub
|
|
|
|
Public Sub BtnPSI(ByVal ctl As IRibbonControl)
|
|
frmProperties.Show
|
|
End Sub
|
|
|
|
Public Sub OnGetScreentip(ByVal ctl As IRibbonControl, ByRef text As Object)
|
|
Dim sText As String
|
|
|
|
Select Case ctl.Id
|
|
Case "btnReset"
|
|
sText = "Remove all comments and markups in this document"
|
|
Case "btnSearch"
|
|
sText = "Locate and markup the elements of this document"
|
|
Case "boxTitle"
|
|
sText = "Enter title for this section of the document"
|
|
Case "btnSection"
|
|
sText = "Mark selected location in the document as a Section"
|
|
Case "btnDelete"
|
|
sText = "Remove all comments and markups from the selected portion of this document"
|
|
Case "cbIdent"
|
|
sText = "Step identifier such as number or bullet"
|
|
Case "cbSeparator"
|
|
sText = "Separator between steps at this level"
|
|
Case "cbLevel"
|
|
sText = "Indentation level for the selected step"
|
|
Case "btnDecrease"
|
|
sText = "Move this step's indentation level to the left"
|
|
Case "btnIncrease"
|
|
sText = "Move this step's indentation level to the right"
|
|
Case "btnMakeXML"
|
|
sText = "Create PROMS Import File"
|
|
Case "btnImport2PROMS"
|
|
sText = "Under Development"
|
|
Case "cbSetup"
|
|
sText = "File containing setup parameters"
|
|
Case "cbSection"
|
|
sText = "Mark the selected text as the start of a Section"
|
|
Case "btnTitle"
|
|
sText = "Mark the selected text as the Title of this procedure section"
|
|
Case "mnuCaution"
|
|
sText = "Mark the selected text as a Caution"
|
|
Case "mnuEquation"
|
|
sText = "Mark the selected text as an Equation"
|
|
Case "mnuFigure"
|
|
sText = "Mark the selected shape as a Figure"
|
|
Case "mnuNote"
|
|
sText = "Mark the selected text as a Note"
|
|
Case "mnuStep"
|
|
sText = "Mark the selected text as a Step"
|
|
Case "mnuTable"
|
|
sText = "Mark the selected table as a Table"
|
|
Case Else
|
|
sText = ""
|
|
End Select
|
|
|
|
text = sText
|
|
End Sub
|
|
|
|
Public Sub OnGetItemCount(ByVal ctl As IRibbonControl, ByRef Count As Object)
|
|
|
|
Select Case ctl.Id
|
|
Case "cbLevel"
|
|
Count = 9
|
|
Case "cbIdent"
|
|
GetIdents
|
|
Count = UBound(Idents) + 1
|
|
Case "cbSeparator"
|
|
GetSeparators
|
|
Count = UBound(Separators) + 1
|
|
Case "cbSetup"
|
|
SetupFiles = GetSetupFiles
|
|
Count = UBound(SetupFiles) + 1
|
|
Case "cbSection"
|
|
GetSections
|
|
Count = UBound(VESections) + 1
|
|
End Select
|
|
End Sub
|
|
|
|
Public Sub OnGetItemLabel(ByVal ctl As IRibbonControl, ByVal Index As Integer, ByRef Label As Object)
|
|
Select Case ctl.Id
|
|
Case "cbLevel"
|
|
Label = CStr(Index + 1)
|
|
Case "cbIdent"
|
|
Label = Idents(Index)
|
|
Case "cbSeparator"
|
|
Label = Separators(Index)
|
|
Case "cbSetup"
|
|
Label = SetupFiles(Index)
|
|
Case "cbSection"
|
|
Label = VESections(Index).name
|
|
End Select
|
|
End Sub
|
|
|
|
Public Sub OnGetContent(ByVal ctl As IRibbonControl, ByRef content As Object)
|
|
Dim sXML As String
|
|
Dim sName As String
|
|
Dim I As Integer
|
|
Dim J As Integer
|
|
|
|
sXML = ""
|
|
|
|
Select Case ctl.Id
|
|
Case "mnuReset"
|
|
sXML = MakeMenuReset()
|
|
Case "mnuSection", "CTmnuSection"
|
|
GetSections
|
|
sXML = MakeMenuSection()
|
|
Case "mnuStep", "CTmnuStep"
|
|
GetSteps(ThisSection.FmtFile)
|
|
sXML = MakeMenuStep()
|
|
Case "mnuNote", "CTmnuNote"
|
|
GetSteps(ThisSection.FmtFile)
|
|
sXML = MakeMenuNCTF("Note")
|
|
Case "mnuCaution", "CTmnuCaution"
|
|
GetSteps(ThisSection.FmtFile)
|
|
sXML = MakeMenuNCTF("Caution")
|
|
Case "mnuTable", "CTmnuTable"
|
|
GetSteps(ThisSection.FmtFile)
|
|
sXML = MakeMenuNCTF("Table")
|
|
Case "mnuFigure", "CTmnuFigure"
|
|
GetSteps(ThisSection.FmtFile)
|
|
sXML = MakeMenuNCTF("Figure")
|
|
Case "mnuEquation", "CTmnuEquation"
|
|
sXML = MakeMenuEquation()
|
|
Case "mnuCheckoff", "CTmnuCheckoff"
|
|
GetCheckoffs(ThisSection.FmtFile)
|
|
sXML = MakeMenuCheckoff()
|
|
End Select
|
|
|
|
content = sXML
|
|
End Sub
|
|
|
|
Private Function MakeMenuSection() As String
|
|
Dim Cmt As Word.Comment
|
|
Dim sID As String
|
|
Dim sNumber As String
|
|
Dim sTitle As String
|
|
Dim sLabel As String
|
|
Dim sNew As String
|
|
Dim sXML As String
|
|
Dim bAttUseNumbers As Boolean
|
|
Dim bSecFound() As Boolean
|
|
Dim I As Integer
|
|
Dim iAtt As Integer
|
|
Dim iSec As Integer
|
|
|
|
iSec = 1
|
|
iAtt = 1
|
|
ReDim bSecFound(UBound(VESections))
|
|
bAttUseNumbers = False
|
|
If GetNodeValue("//AttUseNumbers") = "True" Then
|
|
bAttUseNumbers = True
|
|
End If
|
|
|
|
sXML = "<menu xmlns='http://schemas.microsoft.com/office/2006/01/customui' >"
|
|
For Each Cmt In App.ActiveDocument.Comments
|
|
If Cmt.Author = "SECTION" Then
|
|
'existing section found
|
|
With Cmt.Range
|
|
If .Paragraphs.Count > 5 Then
|
|
sNumber = Replace(.Paragraphs(4).Range.Text, Chr(13), "")
|
|
sTitle = Replace(.Paragraphs(5).Range.Text, Chr(13), "")
|
|
sID = Replace(.Paragraphs(6).Range.Text, Chr(13), "")
|
|
If IsNumeric(sID) Then
|
|
I = CInt(sID)
|
|
bSecFound(I) = Not VESections(I).IsMultiple
|
|
'If VESections(I).IsMultiple And (VESections(I).MergeStyle = "") Then
|
|
If InStr(1, LCase(sNumber), "attachment") + InStr(1, LCase(sNumber), "appendix") > 0 Then
|
|
If bAttUseNumbers Then
|
|
sNumber = sNumber & " " & iAtt
|
|
Else
|
|
sNumber = sNumber & " " & Chr(64 + iAtt)
|
|
End If
|
|
iAtt = iAtt + 1
|
|
End If
|
|
sLabel = Trim(sNumber & " " & sTitle)
|
|
sXML = sXML & "<menu id='mnuSec" & CStr(iSec) & "' label='" & sLabel & "' >"
|
|
sXML = sXML & "<button id='btnSecGoTo" & Cmt.Index & "' label='Go To' onAction='OnAction_SectionGoTo' />"
|
|
If sTitle = "" Then
|
|
sLabel = "Add Title"
|
|
Else
|
|
sLabel = Trim("Edit Title: " & sTitle)
|
|
End If
|
|
sXML = sXML & "<button id='btnSecTitle" & Cmt.Index & "' label='" & sLabel & "' onAction='OnAction_SectionTitle' />"
|
|
sXML = sXML & "</menu>"
|
|
Else
|
|
sXML = sXML & "<button id='btnUnknown" & CStr(iSec) & "' label='Unknown Section Type' />"
|
|
End If
|
|
End If
|
|
End With
|
|
iSec = iSec + 1
|
|
End If
|
|
Next Cmt
|
|
|
|
sNew = ""
|
|
For I = LBound(bSecFound) To UBound(bSecFound)
|
|
If bSecFound(I) = False Then
|
|
sNew = sNew & "<button id='btnSecNew" & I & "' label='" & VESections(I).name & "' onAction='OnAction_SectionNew' />"
|
|
End If
|
|
Next I
|
|
|
|
If sNew <> "" Then
|
|
If iSec > 1 Then
|
|
sXML = sXML & "<menuSeparator id='mnuSepNew' />"
|
|
End If
|
|
sXML = sXML & "<menu id='mnuSecNew' label='New' >"
|
|
sXML = sXML & sNew
|
|
sXML = sXML & "</menu>"
|
|
End If
|
|
|
|
sXML = sXML & "</menu>"
|
|
|
|
MakeMenuSection = sXML
|
|
|
|
End Function
|
|
|
|
Private Function MakeMenuStep() As String
|
|
Dim sXML As String
|
|
Dim I As Integer
|
|
Dim J As Integer
|
|
|
|
sXML = "<menu xmlns='http://schemas.microsoft.com/office/2006/01/customui' >"
|
|
sXML = sXML & "<menu id='mnuHLS' label='HLS' >"
|
|
For I = 0 To UBound(VESteps)
|
|
With VESteps(I)
|
|
If .Type = "HLS" Then
|
|
sXML = sXML & "<button id='btnStep1" & I & "' label='" & .Menu & "' onAction='OnAction_Step' />"
|
|
End If
|
|
End With
|
|
Next I
|
|
sXML = sXML & "</menu>"
|
|
sXML = sXML & "<menuSeparator id='mnuSepHLS' />"
|
|
sXML = sXML & "<menu id='mnuSub' label='Substep' >"
|
|
For I = 0 To UBound(VESteps)
|
|
With VESteps(I)
|
|
If .Type = "Substep" Then
|
|
sXML = sXML & "<menu id='mnuSub" & I & "' label='" & .Menu & "' >"
|
|
For J = 2 To 9
|
|
sXML = sXML & "<button id='btnStep" & J & I & "' label='Level " & J & "' onAction='OnAction_Step' />"
|
|
Next J
|
|
sXML = sXML & "</menu>"
|
|
End If
|
|
End With
|
|
Next I
|
|
sXML = sXML & "</menu>"
|
|
sXML = sXML & "</menu>"
|
|
|
|
MakeMenuStep = sXML
|
|
End Function
|
|
|
|
Private Function MakeMenuNCTF(ByVal sType As String) As String
|
|
Dim sXML As String
|
|
Dim I As Integer
|
|
|
|
sXML = "<menu xmlns='http://schemas.microsoft.com/office/2006/01/customui' >"
|
|
For I = 0 To UBound(VESteps)
|
|
With VESteps(I)
|
|
If InStr(LCase(.Type), LCase(sType)) > 0 Then
|
|
sXML = sXML & "<button id='btnStep" & Left(sType, 1) & I & "' label='" & .Menu & "' onAction='OnAction_" & sType & "' />"
|
|
End If
|
|
End With
|
|
Next I
|
|
sXML = sXML & "</menu>"
|
|
|
|
MakeMenuNCTF = sXML
|
|
End Function
|
|
|
|
Private Function MakeMenuTable() As String
|
|
Dim sXML As String
|
|
|
|
sXML = "<menu xmlns='http://schemas.microsoft.com/office/2006/01/customui' >"
|
|
sXML = sXML & "<button id='btnTCTT' label='Text Table' onAction='OnAction_Table' />"
|
|
sXML = sXML & "<button id='btnTATT' label='AER Table' onAction='OnAction_Table' />"
|
|
sXML = sXML & "</menu>"
|
|
|
|
MakeMenuTable = sXML
|
|
|
|
End Function
|
|
|
|
Private Function MakeMenuFigure() As String
|
|
Dim sXML As String
|
|
|
|
sXML = "<menu xmlns='http://schemas.microsoft.com/office/2006/01/customui' >"
|
|
sXML = sXML & "<menu id='mnuFC' label='Centered' >"
|
|
sXML = sXML & "<button id='btnFCWB' label='With Border' onAction='OnAction_Figure' />"
|
|
sXML = sXML & "<button id='btnFCWOB' label='Without Border' onAction='OnAction_Figure' />"
|
|
sXML = sXML & "</menu>"
|
|
sXML = sXML & "<menuSeparator id='mnuSepFC' />"
|
|
sXML = sXML & "<menu id='mnuFL' label='Left' >"
|
|
sXML = sXML & "<button id='btnFLWB' label='With Border' onAction='OnAction_Figure' />"
|
|
sXML = sXML & "<button id='btnFLWOB' label='Without Border' onAction='OnAction_Figure' />"
|
|
sXML = sXML & "</menu>"
|
|
sXML = sXML & "</menu>"
|
|
|
|
MakeMenuFigure = sXML
|
|
|
|
End Function
|
|
|
|
Private Function MakeMenuEquation() As String
|
|
Dim sXML As String
|
|
|
|
sXML = "<menu xmlns='http://schemas.microsoft.com/office/2006/01/customui' >"
|
|
sXML = sXML & "<menu id='mnuEC' label='Centered' >"
|
|
sXML = sXML & "<button id='btnECWB' label='With Border' onAction='OnAction_Equation' />"
|
|
sXML = sXML & "<button id='btnECWOB' label='Without Border' onAction='OnAction_Equation' />"
|
|
sXML = sXML & "</menu>"
|
|
sXML = sXML & "<menuSeparator id='mnuSepEC' />"
|
|
sXML = sXML & "<menu id='mnuEL' label='Left' >"
|
|
sXML = sXML & "<button id='btnELWB' label='With Border' onAction='OnAction_Equation' />"
|
|
sXML = sXML & "<button id='btnELWOB' label='Without Border' onAction='OnAction_Equation' />"
|
|
sXML = sXML & "</menu>"
|
|
sXML = sXML & "</menu>"
|
|
|
|
MakeMenuEquation = sXML
|
|
|
|
End Function
|
|
|
|
Private Function MakeMenuReset() As String
|
|
Dim sXML As String
|
|
|
|
sXML = "<menu xmlns='http://schemas.microsoft.com/office/2006/01/customui' >"
|
|
sXML = sXML & "<button id='ResetSections' label='Sections' onAction='OnAction_Reset' />"
|
|
sXML = sXML & "<button id='ResetSteps' label='Steps' onAction='OnAction_Reset' />"
|
|
sXML = sXML & "<button id='ResetNotes' label='Notes' onAction='OnAction_Reset' />"
|
|
sXML = sXML & "<button id='ResetCautions' label='Cautions' onAction='OnAction_Reset' />"
|
|
sXML = sXML & "<button id='ResetTables' label='Tables' onAction='OnAction_Reset' />"
|
|
sXML = sXML & "<button id='ResetFigures' label='Figures' onAction='OnAction_Reset' />"
|
|
sXML = sXML & "<button id='ResetEquations' label='Equations' onAction='OnAction_Reset' />"
|
|
sXML = sXML & "<button id='ResetIgnored' label='Ignored' onAction='OnAction_Reset' />"
|
|
sXML = sXML & "<menuSeparator id='mnuSepEC' />"
|
|
sXML = sXML & "<button id='ResetAll' label='All' onAction='OnAction_Reset' />"
|
|
sXML = sXML & "</menu>"
|
|
|
|
MakeMenuReset = sXML
|
|
|
|
End Function
|
|
Private Function MakeMenuCheckoff() As String
|
|
Dim sXML As String
|
|
Dim sName As String
|
|
Dim I As Integer
|
|
|
|
sXML = "<menu xmlns='http://schemas.microsoft.com/office/2006/01/customui' >"
|
|
For I = 0 To UBound(VECheckoffs)
|
|
With VECheckoffs(I)
|
|
If .Menu <> "" Then
|
|
sName = "CO_" & .FmtFile & "(" & .ID & ")"
|
|
sXML = sXML & "<menu id='mnuCO" & I & "' label='" & .Menu & "' >"
|
|
sXML = sXML & "<button id='btnMarkCO" & I & "' label='Mark As " & sName & "' onAction='OnAction_Checkoff' />"
|
|
sXML = sXML & "<button id='btnReplaceCO" & I & "' label='Find And Replace All' onAction='OnAction_Checkoff' />"
|
|
sXML = sXML & "</menu>"
|
|
End If
|
|
End With
|
|
Next I
|
|
sXML = sXML & "</menu>"
|
|
|
|
MakeMenuCheckoff = sXML
|
|
|
|
End Function
|
|
|
|
Public Sub OnChange(ByVal ctl As IRibbonControl, ByRef text As Object)
|
|
Dim I As Integer
|
|
|
|
Select Case ctl.Id
|
|
Case "cbLevel"
|
|
ThisLevel = text
|
|
Case "cbIdent"
|
|
ThisIdent = text
|
|
Case "cbSeparator"
|
|
ThisSeparator = text
|
|
Case "cbSetup"
|
|
ClearDocProperties
|
|
ThisSetup = text
|
|
DocPropertySave(App.ActiveDocument, "SetupFile", ThisSetup)
|
|
LoadSetup
|
|
ChangeSetup
|
|
ThisSection = VESections(0)
|
|
UpdateRibbon
|
|
Case "cbSection"
|
|
For I = 0 To UBound(VESections)
|
|
If VESections(I).name = text Then
|
|
ThisSection = VESections(I)
|
|
ThisSectionID = I
|
|
Exit For
|
|
End If
|
|
Next I
|
|
End Select
|
|
End Sub
|
|
|
|
Public Sub OnAction_Step(ByVal ctl As IRibbonControl)
|
|
Dim rng As Word.Range
|
|
Dim sID As String
|
|
Dim I As Integer
|
|
Dim iCount As Integer
|
|
|
|
sID = Replace(ctl.Id, "btnStep", "")
|
|
If IsNumeric(Left(sID, 1)) Then
|
|
ThisLevel = Left(sID, 1)
|
|
End If
|
|
|
|
sID = Mid(sID, 2)
|
|
|
|
'RemoveComments False
|
|
With App.Selection
|
|
If .Information(Word.WdInformation.wdInCommentPane) Then
|
|
.Comments(1).Scope.Select()
|
|
End If
|
|
|
|
rng = .Range
|
|
iCount = .Paragraphs.Count
|
|
For I = 1 To iCount
|
|
.Paragraphs(I).Range.Select()
|
|
.End = .End - 1
|
|
FlagStep(sID)
|
|
Next I
|
|
rng.Select()
|
|
End With
|
|
|
|
End Sub
|
|
Public Sub OnAction_SectionNew(ByVal ctl As IRibbonControl)
|
|
Dim sSecNum As String
|
|
|
|
'strip off common button text to reveal section number
|
|
sSecNum = Replace(ctl.Id, "btnSecNew", "")
|
|
If IsNumeric(sSecNum) Then
|
|
'RemoveComments
|
|
With App.Selection
|
|
If Len(App.Selection.Text) < 2 Then
|
|
.InsertParagraphBefore()
|
|
.Paragraphs(1).Range.Select()
|
|
.InsertBefore("SECTION")
|
|
.Font.Italic = True
|
|
End If
|
|
End With
|
|
ThisSection = VESections(CInt(sSecNum))
|
|
FlagSection ThisSection
|
|
End If
|
|
|
|
End Sub
|
|
|
|
Public Sub OnAction_SectionGoTo(ByVal ctl As IRibbonControl)
|
|
Dim sCmtIndex As String
|
|
|
|
'strip off common button text to reveal section number
|
|
sCmtIndex = Replace(ctl.Id, "btnSecGoTo", "")
|
|
If IsNumeric(sCmtIndex) Then
|
|
App.ActiveDocument.Comments(CInt(sCmtIndex)).Scope.Select()
|
|
End If
|
|
End Sub
|
|
|
|
Public Sub OnAction_SectionTitle(ByVal ctl As IRibbonControl)
|
|
Dim Cmt As Word.Comment
|
|
Dim rng As Word.Range
|
|
Dim sCmtIndex As String
|
|
Dim sOld As String
|
|
Dim sNew As String
|
|
|
|
'strip off common button text to reveal section number
|
|
sCmtIndex = Replace(ctl.Id, "btnSecTitle", "")
|
|
If IsNumeric(sCmtIndex) Then
|
|
Cmt = App.ActiveDocument.Comments(CInt(sCmtIndex))
|
|
With Cmt.Range
|
|
sOld = Replace(.Paragraphs(5).Range.Text, Chr(13), "")
|
|
If sOld = "" Then
|
|
sOld = Replace(App.Selection.Text, Chr(13), "")
|
|
End If
|
|
sNew = InputBox("Title", "Change Title", sOld)
|
|
If sNew <> "" Then
|
|
rng = .Paragraphs(5).Range
|
|
rng.End = rng.End - 1
|
|
rng.Text = sNew
|
|
Cmt.Scope.Select()
|
|
End If
|
|
End With
|
|
End If
|
|
Me.ribbon.Invalidate()
|
|
|
|
End Sub
|
|
|
|
Public Sub OnAction_Caution(ByVal ctl As IRibbonControl)
|
|
Dim sID As String
|
|
Dim I As Integer
|
|
|
|
I = Len(ctl.Id)
|
|
|
|
While I > 0 And IsNumeric(Mid(ctl.Id, I, 1))
|
|
sID = Mid(ctl.Id, I)
|
|
I = I - 1
|
|
End While
|
|
|
|
ThisIdent = "CAUTION"
|
|
FlagStep(sID)
|
|
|
|
End Sub
|
|
Public Sub OnAction_Note(ByVal ctl As IRibbonControl)
|
|
Dim sID As String
|
|
Dim I As Integer
|
|
|
|
I = Len(ctl.Id)
|
|
|
|
While I > 0 And IsNumeric(Mid(ctl.Id, I, 1))
|
|
sID = Mid(ctl.Id, I)
|
|
I = I - 1
|
|
End While
|
|
|
|
ThisIdent = "NOTE"
|
|
FlagStep(sID)
|
|
|
|
End Sub
|
|
Public Sub OnAction_Table(ByVal ctl As IRibbonControl)
|
|
Dim sID As String
|
|
Dim I As Integer
|
|
|
|
I = Len(ctl.Id)
|
|
|
|
While I > 0 And IsNumeric(Mid(ctl.Id, I, 1))
|
|
sID = Mid(ctl.Id, I)
|
|
I = I - 1
|
|
End While
|
|
|
|
FlagTable(sID)
|
|
|
|
End Sub
|
|
Public Sub OnAction_Figure(ByVal ctl As IRibbonControl)
|
|
Dim sID As String
|
|
Dim I As Integer
|
|
|
|
I = Len(ctl.Id)
|
|
|
|
While I > 0 And IsNumeric(Mid(ctl.Id, I, 1))
|
|
sID = Mid(ctl.Id, I)
|
|
I = I - 1
|
|
End While
|
|
|
|
FlagFigure(sID)
|
|
|
|
End Sub
|
|
Public Sub OnAction_Equation(ByVal ctl As IRibbonControl)
|
|
Dim sMsg As String
|
|
|
|
Select Case ctl.Id
|
|
Case "ECWB"
|
|
sMsg = "Centered With Border"
|
|
Case "ECWOB"
|
|
sMsg = "Centered Without Border"
|
|
Case "ELWB"
|
|
sMsg = "Left With Border"
|
|
Case "ELWOB"
|
|
sMsg = "Left Without Border"
|
|
End Select
|
|
|
|
'RemoveComments False
|
|
InsertComment("EQUATION", sMsg)
|
|
End Sub
|
|
Public Sub OnAction_Reset(ByVal ctl As IRibbonControl)
|
|
Dim rng As Word.Range
|
|
Dim I As Integer
|
|
|
|
|
|
rng = App.Selection.Range
|
|
App.ActiveDocument.Content.Select()
|
|
|
|
Select Case ctl.Id
|
|
Case "ResetSections"
|
|
RemoveComments(False, "SECTION")
|
|
Case "ResetSteps"
|
|
For I = 9 To 1 Step -1
|
|
RemoveComments(False, "STEP " & I)
|
|
Next I
|
|
Case "ResetNotes"
|
|
RemoveComments(False, "NOTE")
|
|
Case "ResetCautions"
|
|
RemoveComments(False, "CAUTION")
|
|
Case "ResetTables"
|
|
RemoveComments(False, "TABLE")
|
|
Case "ResetFigures"
|
|
RemoveComments(False, "FIGURE")
|
|
Case "ResetEquations"
|
|
RemoveComments(False, "EQUATION")
|
|
Case "ResetIgnored"
|
|
RemoveComments(False, "IGNORE")
|
|
Case "ResetAll"
|
|
RemoveComments(True)
|
|
End Select
|
|
|
|
rng.Select()
|
|
|
|
End Sub
|
|
Public Sub OnAction_Checkoff(ByVal ctl As IRibbonControl)
|
|
Dim rng As Word.Range
|
|
Dim Cmt As Word.Comment
|
|
Dim sID As String
|
|
Dim sFmtFile As String
|
|
Dim sTag As String
|
|
Dim I As Integer
|
|
Dim J As Integer
|
|
|
|
'ensure VECheckoffs have been loaded
|
|
On Error Resume Next
|
|
I = UBound(VECheckoffs)
|
|
If Err.Number <> 0 Then
|
|
GetCheckoffs(ThisSection.FmtFile)
|
|
Err.Clear()
|
|
End If
|
|
On Error GoTo 0
|
|
|
|
If ctl.Id Like "btnMark*" Then
|
|
sID = Replace(ctl.Id, "btnMarkCO", "")
|
|
sFmtFile = VECheckoffs(CInt(sID)).FmtFile
|
|
sTag = "CO_" & sFmtFile & "(" & sID & ")"
|
|
|
|
If App.Selection.Information(Word.WdInformation.wdInCommentPane) = True Then
|
|
Set Cmt = App.Selection.Comments(1)
|
|
AddCheckoff(Cmt, sTag)
|
|
Else
|
|
Set rng = App.Selection.Range
|
|
For I = 1 To rng.Paragraphs.Count
|
|
For J = rng.Paragraphs(I).Range.Comments.Count To 1 Step -1
|
|
Set Cmt = rng.Paragraphs(I).Range.Comments(J)
|
|
AddCheckoff(Cmt, sTag)
|
|
Next J
|
|
Next I
|
|
rng.Select()
|
|
End If
|
|
|
|
End If
|
|
|
|
End Sub
|
|
Public Sub OnGetText(ByVal ctl As IRibbonControl, ByRef text As Object)
|
|
Select Case ctl.Id
|
|
Case "cbLevel"
|
|
If ThisLevel = "" Then
|
|
ThisLevel = 1
|
|
End If
|
|
text = ThisLevel
|
|
Case "cbIdent"
|
|
If ThisIdent = "" Then
|
|
GetIdents
|
|
ThisIdent = Idents(0)
|
|
End If
|
|
text = ThisIdent
|
|
Case "cbSeparator"
|
|
If ThisSeparator = "" Then
|
|
GetSeparators
|
|
ThisSeparator = Separators(0)
|
|
End If
|
|
text = ThisSeparator
|
|
Case "cbSetup"
|
|
If ThisSetup = "" Then
|
|
ThisSetup = DocPropertyGet(App.ActiveDocument, "SetupFile")
|
|
If ThisSetup = "" Then
|
|
SetupFiles = GetSetupFiles()
|
|
ThisSetup = SetupFiles(0)
|
|
DocPropertySave(App.ActiveDocument, "SetupFile", ThisSetup)
|
|
End If
|
|
LoadSetup
|
|
ChangeSetup
|
|
ThisSection = VESections(0)
|
|
UpdateRibbon
|
|
End If
|
|
text = ThisSetup
|
|
Case "cbSection"
|
|
If ThisSection.name = "" Then
|
|
GetSections
|
|
ThisSection = VESections(0)
|
|
End If
|
|
text = ThisSection.name
|
|
End Select
|
|
End Sub
|
|
|
|
Public Sub OnGetItemID(ByVal ctl As IRibbonControl, ByRef Index As Integer, ByRef value)
|
|
Select Case ctl.Id
|
|
Case "cbLevel"
|
|
Case "cbIdent"
|
|
Case "cbSeparator"
|
|
Case "cbSetup"
|
|
Case "cbSection"
|
|
value = ThisSection.ID
|
|
End Select
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
#End Region
|
|
|
|
#Region "Helpers"
|
|
|
|
Private Shared Function GetResourceText(ByVal resourceName As String) As String
|
|
Dim asm As Reflection.Assembly = Reflection.Assembly.GetExecutingAssembly()
|
|
Dim resourceNames() As String = asm.GetManifestResourceNames()
|
|
For i As Integer = 0 To resourceNames.Length - 1
|
|
If String.Compare(resourceName, resourceNames(i), StringComparison.OrdinalIgnoreCase) = 0 Then
|
|
Using resourceReader As IO.StreamReader = New IO.StreamReader(asm.GetManifestResourceStream(resourceNames(i)))
|
|
If resourceReader IsNot Nothing Then
|
|
Return resourceReader.ReadToEnd()
|
|
End If
|
|
End Using
|
|
End If
|
|
Next
|
|
Return Nothing
|
|
End Function
|
|
|
|
#End Region
|
|
|
|
End Class
|