2017 lines
80 KiB
VB.net
2017 lines
80 KiB
VB.net
Option Explicit On
|
|
'Imports Microsoft.Office.Interop.Word
|
|
|
|
Module Tools
|
|
Private FixMe As String
|
|
|
|
Public Sub IsolatePageBreaks()
|
|
Dim rng As Word.Range
|
|
|
|
App.ActiveDocument.Paragraphs(1).Range.Select()
|
|
App.Selection.Collapse(Direction:=Word.WdCollapseDirection.wdCollapseStart)
|
|
|
|
App.Selection.Find.ClearFormatting()
|
|
App.Selection.Find.Replacement.ClearFormatting()
|
|
|
|
With App.Selection.Find
|
|
.Text = "^m"
|
|
.Forward = True
|
|
.Wrap = Word.WdFindWrap.wdFindStop
|
|
.Format = False
|
|
.MatchCase = False
|
|
.MatchWholeWord = False
|
|
.MatchWildcards = False
|
|
.MatchSoundsLike = False
|
|
.MatchAllWordForms = False
|
|
End With
|
|
|
|
While App.Selection.Find.Execute
|
|
rng = App.ActiveDocument.Range(App.Selection.End, App.Selection.End + 1)
|
|
If rng.Text <> Chr(13) Then
|
|
App.Selection.InsertParagraphAfter()
|
|
App.Selection.End = App.Selection.End - 1
|
|
End If
|
|
|
|
rng = App.ActiveDocument.Range(App.Selection.Start - 1, App.Selection.Start)
|
|
If rng.Text <> Chr(13) Then
|
|
App.Selection.InsertParagraphBefore()
|
|
App.Selection.Start = App.Selection.Start + 1
|
|
End If
|
|
App.Selection.ParagraphFormat.Style = App.ActiveDocument.Styles("Normal").NameLocal
|
|
End While
|
|
End Sub
|
|
|
|
Public Sub PreSearchCleanup()
|
|
Dim para As Word.Paragraph
|
|
Dim vReplace As Object
|
|
Dim vWith As Object
|
|
Dim sTemp As String
|
|
Dim I As Long
|
|
Dim J As Integer
|
|
Dim K As Integer
|
|
Dim bWildCards As Boolean
|
|
|
|
On Error Resume Next
|
|
|
|
With App.Selection.Find
|
|
.ClearFormatting()
|
|
.Replacement.ClearFormatting()
|
|
.Forward = True
|
|
.Wrap = Word.WdFindWrap.wdFindContinue
|
|
.Format = False
|
|
.MatchCase = True
|
|
.MatchWholeWord = False
|
|
.MatchWildcards = False
|
|
.MatchSoundsLike = False
|
|
.MatchAllWordForms = False
|
|
End With
|
|
|
|
With App.ActiveDocument
|
|
'replace page breaks
|
|
If GetNodeValue("//Search/RemovePageBreaks") = "True" Then
|
|
App.Selection.Find.Execute(FindText:="^m", ReplaceWith:="", Replace:=Word.WdReplace.wdReplaceAll)
|
|
End If
|
|
|
|
'remove blank paragraphs
|
|
If GetNodeValue("//Search/RemoveBlankPara") = "True" Then
|
|
For I = .Paragraphs.Count To 1 Step -1
|
|
App.StatusBar = "Remove blank paragraphs " & I
|
|
If .Paragraphs(I).Range.Text = Chr(13) Then
|
|
.Paragraphs(I).Range.Delete()
|
|
End If
|
|
Next I
|
|
End If
|
|
|
|
'remove section breaks
|
|
If GetNodeValue("//Search/RemoveSectionBreaks") = "True" Then
|
|
App.Selection.Find.Execute(FindText:="^b", ReplaceWith:="", Replace:=Word.WdReplace.wdReplaceAll)
|
|
End If
|
|
|
|
'replace words
|
|
If GetNodeValue("//Search/ReplaceWords") = "True" Then
|
|
If GetNodeValue("//Search/ReplaceWildCards") = "True" Then
|
|
bWildCards = True
|
|
Else
|
|
bWildCards = False
|
|
End If
|
|
.Paragraphs(1).Range.Select()
|
|
App.Selection.Collapse(Direction:=Word.WdCollapseDirection.wdCollapseStart)
|
|
App.Selection.Find.Wrap = Word.WdFindWrap.wdFindStop
|
|
|
|
vReplace = GetListValues("Replace", "str")
|
|
vWith = GetListValues("Replace", "with")
|
|
For I = 0 To UBound(vReplace)
|
|
'word will not find paragraphs containing shapes so we have to delete them
|
|
If InStr(1, vReplace(I), "^p") > 0 Then
|
|
'strip special codes from search string
|
|
sTemp = CStr(vReplace(I))
|
|
J = InStr(sTemp, "^")
|
|
While J > 0
|
|
sTemp = Left(sTemp, J - 1) & Mid(sTemp, J + 2)
|
|
J = InStr(sTemp, "^")
|
|
End While
|
|
'strip shapes from any paragraph containing search word
|
|
.Paragraphs(1).Range.Select()
|
|
App.Selection.Collapse(Direction:=Word.WdCollapseDirection.wdCollapseStart)
|
|
App.Selection.Find.Wrap = Word.WdFindWrap.wdFindStop
|
|
While App.Selection.Find.Execute(FindText:=sTemp) = True
|
|
For K = App.Selection.Paragraphs(1).Range.ShapeRange.Count To 1 Step -1
|
|
App.Selection.Paragraphs(1).Range.ShapeRange(K).Delete()
|
|
Next K
|
|
'merge format with previous paragraph
|
|
App.Selection.MoveStart(Unit:=Word.WdUnits.wdParagraph, Count:=-1)
|
|
App.Selection.ParagraphFormat = App.Selection.Paragraphs(1).Range.ParagraphFormat
|
|
App.Selection.Collapse(Direction:=Word.WdCollapseDirection.wdCollapseEnd)
|
|
End While
|
|
End If
|
|
'now we can find and replace
|
|
App.Selection.Find.Wrap = Word.WdFindWrap.wdFindContinue
|
|
App.Selection.Find.MatchWildcards = bWildCards
|
|
App.Selection.Find.Execute(FindText:=vReplace(I), ReplaceWith:=vWith(I), Replace:=Word.WdReplace.wdReplaceAll)
|
|
Next I
|
|
End If
|
|
|
|
End With
|
|
|
|
End Sub
|
|
|
|
Public Sub FindSections()
|
|
Dim I As Integer
|
|
Dim J As Integer
|
|
Dim sTemp As String
|
|
Dim sNewTag As String
|
|
Dim CmtType As String
|
|
Dim CurrentSection As VESection
|
|
Dim bFound As Boolean
|
|
|
|
GetSections
|
|
IsolatePageBreaks()
|
|
|
|
If GetNodeValue("//Search/UseSectionHeaderTags") = "True" Then
|
|
With App.ActiveDocument.Sections
|
|
For I = 1 To .Count
|
|
sNewTag = ""
|
|
bFound = False
|
|
If .Item(I).Range.Comments.Count > 0 Then
|
|
CmtType = .Item(I).Range.Comments(1).Author
|
|
Else
|
|
CmtType = ""
|
|
End If
|
|
If CmtType <> "SECTION" Then
|
|
sTemp = .Item(I).Headers(Word.WdHeaderFooterIndex.wdHeaderFooterPrimary).Range.Text
|
|
For J = 0 To UBound(VESections)
|
|
If VESections(J).HeaderTag <> "" And InStr(sTemp, VESections(J).HeaderTag) Then
|
|
If .Item(I).Range.Paragraphs(1).Range.Information(Word.WdInformation.wdWithInTable) Then
|
|
.Item(I).Range.Paragraphs(1).Range.Select()
|
|
App.Selection.SplitTable()
|
|
Else
|
|
.Item(I).Range.Paragraphs(1).Range.InsertParagraphBefore()
|
|
End If
|
|
.Item(I).Range.Paragraphs(1).Range.Select()
|
|
App.Selection.ParagraphFormat.Style = App.ActiveDocument.Styles("Normal").NameLocal
|
|
App.Selection.InsertBefore("SECTION")
|
|
App.Selection.Font.Italic = True
|
|
CurrentSection = VESections(J)
|
|
If Len(CurrentSection.MergeStyle) > 0 Then
|
|
If InStr(CurrentSection.MergeStyle, "PageBreak") > 0 Then
|
|
App.Selection.MoveEndUntil(Cset:=Chr(12), Count:=Word.WdConstants.wdForward)
|
|
Else
|
|
App.Selection.End = App.Selection.Bookmarks("\Page").End - 1
|
|
End If
|
|
End If
|
|
FlagSection(VESections(J))
|
|
bFound = True
|
|
Exit For
|
|
End If
|
|
Next J
|
|
If bFound = False Then
|
|
If I = 1 Then
|
|
App.ActiveDocument.Paragraphs(1).Range.Select()
|
|
|
|
With App.Selection
|
|
If .Comments.Count = 0 Then
|
|
App.ActiveDocument.Range.InsertParagraphBefore()
|
|
App.ActiveDocument.Paragraphs(1).Range.Select()
|
|
.InsertBefore("SECTION")
|
|
.Font.Italic = True
|
|
FlagSection(VESections(0))
|
|
End If
|
|
End With
|
|
End If
|
|
While MoveNext(.Item(I).Range) = True
|
|
If App.Selection.Comments.Count = 0 Then
|
|
If App.Selection.Information(Word.WdInformation.wdWithInTable) = True Then
|
|
If GetIdent(App.Selection.Tables(1).Cell(1, 1).Range.Paragraphs(1).Range, sNewTag) = "SECTION" Then
|
|
CurrentSection = ThisSection
|
|
If CurrentSection.ChangeNumber Then
|
|
CurrentSection.number = sNewTag
|
|
End If
|
|
If Len(CurrentSection.MergeStyle) > 0 Then
|
|
If InStr(CurrentSection.MergeStyle, "PageBreak") > 0 Then
|
|
App.Selection.MoveEndUntil(Cset:=Chr(12), Count:=Word.WdConstants.wdForward)
|
|
Else
|
|
App.Selection.End = App.Selection.Bookmarks("\Page").End - 1
|
|
End If
|
|
End If
|
|
FlagSection CurrentSection
|
|
End If
|
|
ElseIf App.Selection.Information(Word.WdInformation.wdInFieldCode) = True Then
|
|
'do nothing
|
|
ElseIf App.Selection.Information(Word.WdInformation.wdInFieldResult) = True Then
|
|
'do nothing
|
|
ElseIf GetIdent(App.Selection.Range, sNewTag) = "SECTION" Then
|
|
CurrentSection = ThisSection
|
|
If CurrentSection.ChangeNumber Then
|
|
CurrentSection.number = sNewTag
|
|
End If
|
|
If Len(CurrentSection.MergeStyle) > 0 Then
|
|
If InStr(CurrentSection.MergeStyle, "PageBreak") > 0 Then
|
|
App.Selection.MoveEndUntil(Cset:=Chr(12), Count:=Word.WdConstants.wdForward)
|
|
Else
|
|
App.Selection.End = App.Selection.Bookmarks("\Page").End - 1
|
|
End If
|
|
End If
|
|
FlagSection(CurrentSection)
|
|
End If
|
|
End If
|
|
End While
|
|
End If
|
|
End If
|
|
Next I
|
|
End With
|
|
Else
|
|
App.ActiveDocument.Paragraphs(1).Range.Select()
|
|
|
|
With App.Selection
|
|
If .Comments.Count = 0 Then
|
|
App.ActiveDocument.Range.InsertParagraphBefore()
|
|
App.ActiveDocument.Paragraphs(1).Range.Select()
|
|
.InsertBefore("SECTION")
|
|
.Font.Italic = True
|
|
FlagSection(VESections(0))
|
|
End If
|
|
While MoveNext() = True
|
|
If .Comments.Count = 0 Then
|
|
If .Information(Word.WdInformation.wdWithInTable) = True Then
|
|
If GetIdent(App.Selection.Tables(1).Cell(1, 1).Range.Paragraphs(1).Range, sNewTag) = "SECTION" Then
|
|
CurrentSection = ThisSection
|
|
If CurrentSection.ChangeNumber Then
|
|
CurrentSection.number = sNewTag
|
|
End If
|
|
If Len(CurrentSection.MergeStyle) > 0 Then
|
|
If InStr(CurrentSection.MergeStyle, "PageBreak") > 0 Then
|
|
App.Selection.MoveEndUntil(Cset:=Chr(12), Count:=Word.WdConstants.wdForward)
|
|
Else
|
|
App.Selection.End = App.Selection.Bookmarks("\Page").End - 1
|
|
End If
|
|
End If
|
|
FlagSection(CurrentSection)
|
|
End If
|
|
ElseIf .Information(Word.WdInformation.wdInFieldCode) = True Then
|
|
'do nothing
|
|
ElseIf .Information(Word.WdInformation.wdInFieldResult) = True Then
|
|
'do nothing
|
|
ElseIf GetIdent(.Range, sNewTag) = "SECTION" Then
|
|
CurrentSection = ThisSection
|
|
If CurrentSection.ChangeNumber Then
|
|
CurrentSection.number = sNewTag
|
|
End If
|
|
If Len(CurrentSection.MergeStyle) > 0 Then
|
|
If InStr(CurrentSection.MergeStyle, "PageBreak") > 0 Then
|
|
.MoveEndUntil(Cset:=Chr(12), Count:=Word.WdConstants.wdForward)
|
|
Else
|
|
.End = .Bookmarks("\Page").End - 1
|
|
End If
|
|
End If
|
|
FlagSection(CurrentSection)
|
|
End If
|
|
End If
|
|
End While
|
|
End With
|
|
App.ActiveDocument.Paragraphs(1).Range.Select()
|
|
End If
|
|
App.StatusBar = "Find Sections - Done"
|
|
|
|
End Sub
|
|
|
|
|
|
Public Sub ClearDocProperties()
|
|
Dim I As Integer
|
|
Dim sName As String
|
|
|
|
With App.ActiveDocument.CustomDocumentProperties
|
|
For I = .Count To 1 Step -1
|
|
sName = .Item(I).name
|
|
'If sName Like "DOC_*" Or sName Like "PSI_*" Then
|
|
If sName Like "PSI_*" Then
|
|
.Item(I).Delete
|
|
End If
|
|
Next I
|
|
End With
|
|
End Sub
|
|
|
|
Public Sub FlagSection(Section As VESection)
|
|
FindTitle(Section)
|
|
InsertComment("SECTION", Section.name & vbCrLf & Section.Style & vbCrLf & Section.Type & vbCrLf & Section.number & vbCrLf & Section.Title & vbCrLf & Section.ID)
|
|
End Sub
|
|
|
|
Public Sub FindTitle(ByRef Section As VESection)
|
|
|
|
If Section.Title = "" Then
|
|
Select Case LCase(Section.FindTitle)
|
|
Case "afterhyphen"
|
|
FixMe = App.Selection.Paragraphs(1).Range.Text
|
|
FixText()
|
|
|
|
If InStr(1, FixMe, Chr(45)) > 0 Then
|
|
FixMe = Mid(FixMe, InStr(1, FixMe, Chr(45)) + 1)
|
|
FixMe = Trim(FixMe)
|
|
Section.Title = FixMe
|
|
End If
|
|
Case "nextparagraph"
|
|
FixMe = App.Selection.Paragraphs(1).Next.Range.Text
|
|
FixText()
|
|
Section.Title = FixMe
|
|
Case "thisparagraph"
|
|
FixMe = App.Selection.Paragraphs(1).Range.Text
|
|
FixText()
|
|
Section.Title = FixMe
|
|
End Select
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub FixText()
|
|
FixMe = Replace(FixMe, Chr(160), " ")
|
|
FixMe = Replace(FixMe, Chr(150), Chr(45))
|
|
FixMe = Replace(FixMe, Chr(30), Chr(45))
|
|
FixMe = Replace(FixMe, Chr(13), "")
|
|
FixMe = Replace(FixMe, Chr(12), "")
|
|
FixMe = Replace(FixMe, Chr(9), " ")
|
|
FixMe = Trim(FixMe)
|
|
|
|
End Sub
|
|
|
|
Public Sub MergeSections()
|
|
Dim Cmt As Word.Comment
|
|
Dim rng As Word.Range
|
|
Dim I As Integer
|
|
Dim J As Integer
|
|
Dim iCmtCount As Integer
|
|
Dim bFoundFirst As Boolean
|
|
Dim bDone As Boolean
|
|
Dim sID As String
|
|
Dim sIsMerged As String
|
|
|
|
'On Error Resume Next
|
|
GetSections
|
|
For I = 1 To UBound(VESections)
|
|
With VESections(I)
|
|
If .MergeStyle <> "" Then
|
|
bFoundFirst = False
|
|
While bDone = False
|
|
bDone = True
|
|
For J = 1 To App.ActiveDocument.Comments.Count
|
|
Cmt = App.ActiveDocument.Comments(J)
|
|
If Cmt.Author = "SECTION" Then
|
|
With Cmt.Range
|
|
sID = LCase(Replace(.Paragraphs(6).Range.Text, Chr(13), ""))
|
|
If .Paragraphs.Count > 6 Then
|
|
sIsMerged = LCase(Replace(.Paragraphs(7).Range.Text, Chr(13), ""))
|
|
Else
|
|
sIsMerged = ""
|
|
End If
|
|
End With
|
|
If CInt(sID) = I And sIsMerged = "" Then
|
|
Cmt.Scope.Select()
|
|
RemoveComments()
|
|
|
|
If Len(App.Selection.Range.Text) > 0 Then
|
|
'App.Selection.End = App.ActiveDocument.Bookmarks("\Page").End
|
|
App.Selection.Cut()
|
|
App.DoEvents
|
|
If bFoundFirst = False Then
|
|
rng = App.ActiveDocument.Content
|
|
rng.InsertParagraphAfter()
|
|
rng.Collapse(Direction:=Word.WdCollapseDirection.wdCollapseEnd)
|
|
rng.Paste()
|
|
rng.Paragraphs(1).Range.Select()
|
|
FlagSection(VESections(I))
|
|
Cmt = App.ActiveDocument.Comments(App.ActiveDocument.Comments.Count)
|
|
Cmt.Author = "PARENT SECTION"
|
|
'cmt.Range.InsertAfter vbCrLf & "MERGED"
|
|
bFoundFirst = True
|
|
Else
|
|
If InStr(.MergeStyle, "Collate") > 0 Then
|
|
rng = App.ActiveDocument.Content
|
|
rng.InsertParagraphAfter()
|
|
rng.Collapse(Direction:=Word.WdCollapseDirection.wdCollapseEnd)
|
|
rng.Paste()
|
|
End If
|
|
End If
|
|
Else
|
|
RemoveComments()
|
|
End If
|
|
bDone = False
|
|
Exit For
|
|
End If
|
|
End If
|
|
Next J
|
|
End While
|
|
End If
|
|
End With
|
|
Next I
|
|
For J = App.ActiveDocument.Comments.Count To 1 Step -1
|
|
Cmt = App.ActiveDocument.Comments(J)
|
|
If Cmt.Author = "PARENT SECTION" Then
|
|
Cmt.Author = "SECTION"
|
|
Exit For
|
|
End If
|
|
Next J
|
|
App.ActiveDocument.Paragraphs(1).Range.Select()
|
|
App.StatusBar = "Merge Sections - Done"
|
|
App.DoEvents
|
|
|
|
End Sub
|
|
|
|
Private Function GetDefault(ByVal sType As String) As String
|
|
Dim sReturn As String
|
|
Dim I As Integer
|
|
|
|
'ensure VESteps have been loaded
|
|
On Error Resume Next
|
|
I = UBound(VESteps)
|
|
If Err.Number <> 0 Then
|
|
GetSteps(ThisSection.FmtFile)
|
|
Err.Clear()
|
|
End If
|
|
On Error GoTo 0
|
|
|
|
sReturn = ""
|
|
For I = 0 To UBound(VESteps)
|
|
If InStr(VESteps(I).Deflt, ";" & sType & ";") Then
|
|
sReturn = CStr(I)
|
|
Exit For
|
|
End If
|
|
Next I
|
|
'sReturn = CStr(I)
|
|
GetDefault = sReturn
|
|
|
|
End Function
|
|
|
|
Public Sub AddCheckoff(ByRef Cmt As Word.Comment, ByVal sCheckoff As String)
|
|
Dim sAuthor As String
|
|
Dim sMsg As String
|
|
|
|
sMsg = ""
|
|
sAuthor = Cmt.Author
|
|
If sAuthor Like "STEP*" Then
|
|
With Cmt.Range
|
|
If .Paragraphs.Count > 2 Then
|
|
sMsg = Replace(.Paragraphs(1).Range.Text, Chr(13), "")
|
|
sMsg = sMsg & vbCrLf & Replace(.Paragraphs(2).Range.Text, Chr(13), "")
|
|
sMsg = sMsg & vbCrLf & Replace(.Paragraphs(3).Range.Text, Chr(13), "")
|
|
End If
|
|
If sMsg <> "" Then
|
|
If sCheckoff <> "" Then
|
|
sMsg = sMsg & vbCrLf & sCheckoff
|
|
End If
|
|
ModifyComment(Cmt, sMsg)
|
|
End If
|
|
End With
|
|
End If
|
|
End Sub
|
|
|
|
Public Function FlagStep(Optional sID As String = "") As String
|
|
Dim I As Integer
|
|
|
|
'ensure VESteps have been loaded
|
|
On Error Resume Next
|
|
I = UBound(VESteps)
|
|
If Err.Number <> 0 Then
|
|
GetSteps(ThisSection.FmtFile)
|
|
Err.Clear()
|
|
End If
|
|
On Error GoTo 0
|
|
|
|
If sID = "" Then
|
|
Select Case ThisIdent
|
|
Case "NUMBER", "BULLET", "DASH", "PARAGRAPH"
|
|
If ThisLevel = 1 Then
|
|
sID = GetDefault("HLS" & ThisIdent)
|
|
Else
|
|
sID = GetDefault("SUBSTEP" & ThisIdent)
|
|
End If
|
|
Case Else
|
|
sID = GetDefault(ThisIdent)
|
|
End Select
|
|
End If
|
|
I = CInt(sID)
|
|
|
|
If I <= UBound(VESteps) Then
|
|
With VESteps(I)
|
|
If .Type = "HLS" Then
|
|
ThisLevel = 1
|
|
InsertComment("STEP " & ThisLevel, .Menu & vbCrLf & .FmtFile & "(" & I & ")" & vbCrLf & .Type)
|
|
ElseIf .Type = "Substep" Then
|
|
InsertComment("STEP " & ThisLevel, .Menu & vbCrLf & .FmtFile & "(" & I & ")" & vbCrLf & .Type)
|
|
ElseIf .Type = "Caution" Then
|
|
InsertComment("CAUTION", .Menu & vbCrLf & .FmtFile & "(" & I & ")" & vbCrLf & .Type)
|
|
ElseIf .Type = "Note" Then
|
|
InsertComment("NOTE", .Menu & vbCrLf & .FmtFile & "(" & I & ")" & vbCrLf & .Type)
|
|
End If
|
|
End With
|
|
End If
|
|
|
|
FlagStep = sID
|
|
End Function
|
|
|
|
Public Sub FlagTable(Optional sID As String = "")
|
|
Dim I As Integer
|
|
Dim J As Integer
|
|
Dim rng As Word.Range
|
|
|
|
rng = App.Selection.Range
|
|
|
|
If rng.Tables.Count > 0 Then
|
|
|
|
'ensure VESteps have been loaded
|
|
On Error Resume Next
|
|
I = UBound(VESteps)
|
|
If Err.Number <> 0 Then
|
|
GetSteps(ThisSection.FmtFile)
|
|
Err.Clear()
|
|
End If
|
|
On Error GoTo 0
|
|
|
|
If sID = "" Then
|
|
sID = GetDefault("TABLE")
|
|
End If
|
|
I = CInt(sID)
|
|
|
|
If I <= UBound(VESteps) Then
|
|
'RemoveComments
|
|
For J = 1 To rng.Tables.Count
|
|
rng.Tables(J).Select()
|
|
|
|
With VESteps(I)
|
|
InsertComment("TABLE", .Menu & vbCrLf & .FmtFile & "(" & sID & ")" & vbCrLf & .Type)
|
|
End With
|
|
Next J
|
|
End If
|
|
End If
|
|
|
|
End Sub
|
|
|
|
Public Sub FlagFigure(Optional sID As String = "")
|
|
Dim I As Integer
|
|
Dim rng As Word.Range
|
|
Dim shp As Word.Shape
|
|
|
|
rng = App.Selection.Range
|
|
|
|
If rng.ShapeRange.Count > 0 Then
|
|
|
|
'ensure VESteps have been loaded
|
|
On Error Resume Next
|
|
I = UBound(VESteps)
|
|
If Err.Number <> 0 Then
|
|
GetSteps(ThisSection.FmtFile)
|
|
Err.Clear()
|
|
End If
|
|
On Error GoTo 0
|
|
|
|
If sID = "" Then
|
|
sID = GetDefault("FIGURE")
|
|
End If
|
|
I = CInt(sID)
|
|
|
|
If I <= UBound(VESteps) Then
|
|
'RemoveComments
|
|
For Each shp In rng.ShapeRange
|
|
If shp.Type = Office.MsoShapeType.msoPicture Then
|
|
'this is a picture so flag it as a FIGURE
|
|
If shp.WrapFormat.Type <> Word.WdWrapType.wdWrapInline Then
|
|
shp.WrapFormat.Type = Word.WdWrapType.wdWrapInline
|
|
App.Selection.Collapse(Direction:=Word.WdCollapseDirection.wdCollapseEnd)
|
|
App.Selection.Paragraphs(1).Format.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
|
|
End If
|
|
shp.Select()
|
|
|
|
With VESteps(I)
|
|
InsertComment("FIGURE", .Menu & vbCrLf & .FmtFile & "(" & sID & ")" & vbCrLf & .Type)
|
|
End With
|
|
End If
|
|
Next shp
|
|
End If
|
|
End If
|
|
|
|
End Sub
|
|
|
|
|
|
Public Sub FindShapes()
|
|
Dim shp As Word.Shape
|
|
Dim rng As Word.Range
|
|
Dim tbl As Word.Table
|
|
'Dim iType As Integer
|
|
Dim sHeader As String
|
|
Dim I As Integer
|
|
|
|
App.ActiveDocument.Paragraphs(1).Range.Select()
|
|
App.StatusBar = "Find Shapes"
|
|
|
|
GetSectionData
|
|
GetSectionRanges
|
|
|
|
For I = 0 To UBound(sSecType)
|
|
If UCase(sSecType(I)) = "PROMS" Then
|
|
rng = App.ActiveDocument.Range(lSecStart(I), lSecEnd(I))
|
|
For Each shp In rng.ShapeRange
|
|
Select Case shp.Type
|
|
Case Office.MsoShapeType.msoPicture
|
|
'this is a picture so flag it as a FIGURE
|
|
If shp.WrapFormat.Type <> Word.WdWrapType.wdWrapInline Then
|
|
shp.WrapFormat.Type = Word.WdWrapType.wdWrapInline
|
|
App.Selection.Collapse(Direction:=Word.WdCollapseDirection.wdCollapseEnd)
|
|
App.Selection.Paragraphs(1).Format.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
|
|
End If
|
|
shp.Select()
|
|
FlagFigure()
|
|
Case Office.MsoShapeType.msoTextBox
|
|
'this is a box full of text so see if it is a note/caution or something else we know about
|
|
sHeader = NameFromShape(shp)
|
|
If AddColor(sHeader) = True Then
|
|
'this is a valid item, so convert to a table
|
|
If shp.WrapFormat.Type <> Word.WdWrapType.wdWrapInline Then
|
|
shp.WrapFormat.Type = Word.WdWrapType.wdWrapInline
|
|
App.Selection.Collapse(Direction:=Word.WdCollapseDirection.wdCollapseEnd)
|
|
App.Selection.Paragraphs(1).Format.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
|
|
End If
|
|
shp.TextFrame.TextRange.Copy()
|
|
shp.Select()
|
|
App.Selection.Collapse(Direction:=Word.WdCollapseDirection.wdCollapseEnd)
|
|
tbl = App.ActiveDocument.Tables.Add(App.Selection.Range, 1, 1)
|
|
tbl.Cell(1, 1).Range.Paste()
|
|
|
|
With tbl.Borders(Word.WdBorderType.wdBorderTop)
|
|
.LineStyle = Options.DefaultBorderLineStyle
|
|
.LineWidth = Options.DefaultBorderLineWidth
|
|
.Color = Options.DefaultBorderColor
|
|
End With
|
|
With tbl.Borders(Word.WdBorderType.wdBorderLeft)
|
|
.LineStyle = Options.DefaultBorderLineStyle
|
|
.LineWidth = Options.DefaultBorderLineWidth
|
|
.Color = Options.DefaultBorderColor
|
|
End With
|
|
With tbl.Borders(Word.WdBorderType.wdBorderBottom)
|
|
.LineStyle = Options.DefaultBorderLineStyle
|
|
.LineWidth = Options.DefaultBorderLineWidth
|
|
.Color = Options.DefaultBorderColor
|
|
End With
|
|
With tbl.Borders(Word.WdBorderType.wdBorderRight)
|
|
.LineStyle = Options.DefaultBorderLineStyle
|
|
.LineWidth = Options.DefaultBorderLineWidth
|
|
.Color = Options.DefaultBorderColor
|
|
End With
|
|
shp.Delete()
|
|
End If
|
|
End Select
|
|
Next shp
|
|
End If
|
|
Next I
|
|
|
|
App.ActiveDocument.Paragraphs(1).Range.Select()
|
|
App.StatusBar = "Find Shapes - Done"
|
|
|
|
End Sub
|
|
|
|
Public Sub FindStuff()
|
|
'Dim rng As Word.Range
|
|
Dim Cmt As Word.Comment
|
|
Dim sID As String
|
|
|
|
App.ActiveDocument.Paragraphs(1).Range.Select()
|
|
App.StatusBar = "Find Other Stuff"
|
|
|
|
GetSections
|
|
ThisSection = VESections(0)
|
|
While MoveNext() = True
|
|
If App.Selection.Comments.Count > 0 Then
|
|
Cmt = App.Selection.Comments(1)
|
|
If Cmt.Author = "SECTION" Then
|
|
sID = LCase(GetCmtValue(Cmt, "ID"))
|
|
If IsNumeric(sID) Then
|
|
ThisSection = VESections(CInt(sID))
|
|
End If
|
|
End If
|
|
ElseIf ThisSection.Type = "PROMS" Then
|
|
If App.Selection.Comments.Count = 0 Then
|
|
WhatIsThis()
|
|
End If
|
|
Else
|
|
Cmt = MoveToNextComment("SECTION")
|
|
If Not Cmt Is Nothing Then
|
|
sID = LCase(GetCmtValue(Cmt, "ID"))
|
|
If IsNumeric(sID) Then
|
|
ThisSection = VESections(CInt(sID))
|
|
End If
|
|
Else
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
End While
|
|
|
|
App.ActiveDocument.Paragraphs(1).Range.Select()
|
|
App.StatusBar = "Find Other Stuff - Done"
|
|
|
|
End Sub
|
|
|
|
Public Sub FindSteps()
|
|
Dim rng As Word.Range
|
|
Dim C As Word.Cell
|
|
Dim tbl As Word.Table
|
|
'Dim fld As Word.Field
|
|
' Dim sText As String
|
|
Dim sIdent As String
|
|
Dim sLevel As String
|
|
'Dim sID As String
|
|
'Dim sType As String
|
|
Dim FirstIdent(9) As String
|
|
Dim FirstLevel(9) As String
|
|
Dim FirstID(9) As String
|
|
Dim I As Integer
|
|
Dim J As Integer
|
|
Dim K As Integer
|
|
Dim bDone As Boolean
|
|
Static LastMargin As Single
|
|
Static LastLevel As Integer
|
|
|
|
GetSections
|
|
GetSectionData
|
|
|
|
App.ActiveDocument.Paragraphs(1).Range.Select()
|
|
App.StatusBar = "Find Steps"
|
|
|
|
For J = 0 To UBound(sSecType)
|
|
If UCase(sSecType(J)) = "PROMS" Then
|
|
ThisSection = VESections(iSecID(J))
|
|
GetSectionRanges
|
|
rng = App.ActiveDocument.Range(lSecStart(J), lSecEnd(J))
|
|
LastMargin = rng.Paragraphs(1).Range.ParagraphFormat.LeftIndent
|
|
If ThisSection.ColumnMode = "2" Then
|
|
For K = 1 To rng.Tables.Count
|
|
tbl = rng.Tables(K)
|
|
With tbl.Range
|
|
For Each C In .Cells
|
|
C.Range.Select()
|
|
App.Selection.Collapse(Direction:=Word.WdCollapseDirection.wdCollapseStart)
|
|
For I = 1 To 9
|
|
bDone = True
|
|
App.StatusBar = "Find Steps - Level " & I
|
|
LastLevel = 0
|
|
FirstIdent(I) = ""
|
|
FirstLevel(I) = ""
|
|
While MoveNextCellPara(C) = True
|
|
If App.Selection.Comments.Count > 0 Then
|
|
If App.Selection.Comments(1).Author = "STEP " & CStr(I - 1) Then
|
|
'previous level found so reset data for this level
|
|
LastMargin = App.Selection.Paragraphs(1).Range.ParagraphFormat.LeftIndent
|
|
LastLevel = I - 1
|
|
FirstIdent(I) = ""
|
|
FirstLevel(I) = ""
|
|
End If
|
|
Else
|
|
sIdent = GetIdent(App.Selection.Range)
|
|
Select Case sIdent
|
|
Case "IGNORE"
|
|
InsertComment("IGNORE")
|
|
Case "NUMBER", "BULLET", "DASH", "PARAGRAPH"
|
|
sLevel = GetLevelStep(App.Selection.Range, LastMargin, LastLevel, I)
|
|
If FirstIdent(I) = "" Then
|
|
FirstIdent(I) = sIdent
|
|
FirstLevel(I) = sLevel
|
|
ThisLevel = I
|
|
ThisIdent = sIdent
|
|
FirstID(I) = FlagStep()
|
|
ElseIf sIdent = FirstIdent(I) And sLevel = FirstLevel(I) Then
|
|
FlagStep(FirstID(I))
|
|
End If
|
|
bDone = False
|
|
End Select
|
|
End If
|
|
End While
|
|
If bDone = True Then
|
|
Exit For
|
|
End If
|
|
Next I
|
|
Next C
|
|
End With
|
|
Next K
|
|
Else
|
|
For I = 1 To 9
|
|
bDone = True
|
|
App.StatusBar = "Find Steps - Level " & I
|
|
LastLevel = 0
|
|
FirstIdent(I) = ""
|
|
FirstLevel(I) = ""
|
|
rng.Paragraphs(1).Range.Select()
|
|
|
|
While MoveNext() = True And (App.Selection.Start < lSecEnd(J))
|
|
If App.Selection.Comments.Count > 0 Then
|
|
If App.Selection.Comments(1).Author = "STEP " & CStr(I - 1) Then
|
|
'previous level found so reset data for this level
|
|
LastMargin = App.Selection.Paragraphs(1).Range.ParagraphFormat.LeftIndent
|
|
LastLevel = I - 1
|
|
FirstIdent(I) = ""
|
|
FirstLevel(I) = ""
|
|
End If
|
|
Else
|
|
If App.Selection.Information(Word.WdInformation.wdWithInTable) = True Then
|
|
'do nothing
|
|
ElseIf App.Selection.Information(word.WdInformation.wdInFieldCode) = True Then
|
|
'do nothing
|
|
ElseIf App.Selection.Information(word.WdInformation.wdInFieldResult) = True Then
|
|
'do nothing
|
|
Else
|
|
sIdent = GetIdent(App.Selection.Range)
|
|
Select Case sIdent
|
|
Case "IGNORE"
|
|
InsertComment("IGNORE")
|
|
Case "NUMBER", "BULLET", "DASH", "PARAGRAPH"
|
|
sLevel = GetLevelStep(App.Selection.Range, LastMargin, LastLevel)
|
|
If FirstIdent(I) = "" Then
|
|
FirstIdent(I) = sIdent
|
|
FirstLevel(I) = sLevel
|
|
ThisLevel = I
|
|
ThisIdent = sIdent
|
|
FirstID(I) = FlagStep()
|
|
ElseIf sIdent = FirstIdent(I) And sLevel = FirstLevel(I) Then
|
|
FlagStep(FirstID(I))
|
|
End If
|
|
bDone = False
|
|
End Select
|
|
End If
|
|
End If
|
|
End While
|
|
If bDone = True Then
|
|
Exit For
|
|
End If
|
|
Next I
|
|
End If
|
|
End If
|
|
Next J
|
|
|
|
App.ActiveDocument.Paragraphs(1).Range.Select()
|
|
App.StatusBar = "Find Steps - Done"
|
|
End Sub
|
|
|
|
|
|
Public Sub FindItems(Optional App.SelectionOnly As Boolean = False)
|
|
Dim rng As Word.Range
|
|
Dim rngText As Word.Range
|
|
'Dim para As Word.Paragraph
|
|
Dim sParaText As String
|
|
Dim sIdent As String
|
|
Dim sSep As String
|
|
Dim iLevel As Integer
|
|
Dim bDone As Boolean
|
|
Dim iPara As Integer
|
|
Dim TheEnd As Long
|
|
|
|
|
|
If App.SelectionOnly = True Then
|
|
'limit search to the end of current selection
|
|
TheEnd = App.Selection.Paragraphs(App.Selection.Paragraphs.Count).Range.End
|
|
App.Selection.Paragraphs(1).Range.Select
|
|
Else
|
|
'search to the end of the document
|
|
TheEnd = App.ActiveDocument.Paragraphs(App.ActiveDocument.Paragraphs.Count).Range.End
|
|
App.ActiveDocument.Paragraphs(1).Range.Select
|
|
End If
|
|
|
|
With App.Selection
|
|
.Collapse(Direction:=Word.WdCollapseDirection.wdCollapseStart)
|
|
|
|
bDone = False
|
|
|
|
While bDone = False
|
|
'move past table
|
|
.Collapse(Direction:=Word.WdCollapseDirection.wdCollapseEnd)
|
|
.MoveStart(unit:=Word.WdUnits.wdCharacter, Count:=1)
|
|
.Paragraphs(1).Range.Select
|
|
|
|
rng = .Range
|
|
rng.End = TheEnd
|
|
bDone = True
|
|
iPara = 1
|
|
Do While iPara <= rng.Paragraphs.Count
|
|
rngText = rng.Paragraphs(iPara).Range
|
|
rngText.End = rngText.End - 1
|
|
rngText.Select()
|
|
sParaText = CleanText(.text)
|
|
If .Information(Word.WdInformation.wdWithInTable) = True Then
|
|
If .Tables(1).rows.Count = 1 And .Tables(1).Columns.Count = 1 Then
|
|
'Note/Caution/Warning
|
|
NoteFromTable(rngText.Tables(1))
|
|
rngText.Tables(1).Select()
|
|
bDone = False
|
|
Exit Do
|
|
Else
|
|
'imbedded table has been found
|
|
rngText.Tables(1).Select()
|
|
'InsertComment "TABLE"
|
|
FlagTable()
|
|
bDone = False
|
|
Exit Do
|
|
End If
|
|
ElseIf rngText.Information(Word.WdInformation.wdInFieldCode) = True Then
|
|
'do nothing
|
|
ElseIf rngText.Information(Word.WdInformation.wdInFieldResult) = True Then
|
|
'do nothing
|
|
ElseIf sParaText <> "" Then
|
|
sIdent = GetIdent(rng.Paragraphs(iPara).Range)
|
|
If sIdent <> "" Then
|
|
'do not automatically flag unnumbered paragraphs
|
|
'iLevel = GetLevel(rng.Paragraphs(iPara).Range)
|
|
If iPara < rng.Paragraphs.Count Then
|
|
sSep = GetSep(rng.Paragraphs(iPara + 1).Range)
|
|
Else
|
|
sSep = ""
|
|
End If
|
|
rng.Paragraphs(iPara).Range.Select()
|
|
'InsertComment "STEP " & iLevel & " " & sSep, sIdent
|
|
ThisLevel = iLevel
|
|
FlagStep()
|
|
End If
|
|
End If
|
|
iPara = iPara + 1
|
|
Loop
|
|
End While
|
|
End With
|
|
|
|
End Sub
|
|
|
|
Public Function GetIdent(ByVal para As Word.Range, Optional ByRef sNewTag As String = "") As String
|
|
Dim sTag As String
|
|
Dim sIdent As String
|
|
Dim sParaText As String
|
|
Dim I As Integer
|
|
|
|
sNewTag = ""
|
|
sParaText = CleanText(para.Text)
|
|
If CanIgnore(sParaText) = True Then
|
|
sIdent = "IGNORE"
|
|
Else
|
|
|
|
With para
|
|
sTag = .ListFormat.ListString
|
|
If sTag = "" Then
|
|
'not automatic numbering, so find the step number
|
|
For I = 1 To Len(sParaText)
|
|
If InStr(" " & Chr(9) & Chr(11) & Chr(13), Mid(.Text, I, 1)) > 0 Then
|
|
'searh up to the first space, tab, line feed or paragraph
|
|
Exit For
|
|
End If
|
|
sTag = sTag & Mid(.Text, I, 1)
|
|
Next I
|
|
End If
|
|
End With
|
|
|
|
sTag = Replace(sTag, "[", "")
|
|
sTag = Replace(sTag, "]", "")
|
|
|
|
On Error Resume Next
|
|
I = UBound(VESections)
|
|
If Err.Number <> 0 Then
|
|
GetSections
|
|
Err.Clear()
|
|
End If
|
|
On Error GoTo 0
|
|
|
|
If InStr(1, sParaText, "Operational") > 0 Then
|
|
sParaText = sParaText
|
|
End If
|
|
|
|
For I = 0 To UBound(VESections)
|
|
If sTag <> "" Then
|
|
If VESections(I).number <> "" Then
|
|
If sTag = VESections(I).number Then
|
|
'tag matches a section number setting
|
|
If sParaText = VESections(I).Title Then
|
|
'section title matches paragraph text
|
|
sIdent = "SECTION"
|
|
ThisSection = VESections(I)
|
|
Exit For
|
|
End If
|
|
End If
|
|
End If
|
|
End If
|
|
Next I
|
|
If sIdent = "" Then
|
|
For I = 0 To UBound(VESections)
|
|
If sTag <> "" Then
|
|
If VESections(I).number <> "" Then
|
|
If sTag Like VESections(I).number & "*" Then
|
|
'tag matches a section number setting
|
|
If sParaText Like VESections(I).Title & "*" Then
|
|
'section title matches paragraph text
|
|
sIdent = "SECTION"
|
|
ThisSection = VESections(I)
|
|
Exit For
|
|
End If
|
|
End If
|
|
End If
|
|
End If
|
|
Next I
|
|
End If
|
|
If sIdent = "" Then
|
|
For I = 0 To UBound(VESections)
|
|
If sTag <> "" Then
|
|
If VESections(I).number <> "" Then
|
|
If sTag Like VESections(I).number & "*" Then
|
|
If RegExMatch(sParaText, VESections(I).Pattern) = True Then
|
|
sIdent = "SECTION"
|
|
ThisSection = VESections(I)
|
|
Exit For
|
|
End If
|
|
End If
|
|
End If
|
|
End If
|
|
Next I
|
|
End If
|
|
If sIdent = "" Then
|
|
For I = 0 To UBound(VESections)
|
|
If sTag <> "" Then
|
|
If VESections(I).number = "" Then
|
|
If RegExMatch(sTag, VESections(I).Pattern) = True Then
|
|
sIdent = "SECTION"
|
|
ThisSection = VESections(I)
|
|
Exit For
|
|
End If
|
|
End If
|
|
End If
|
|
Next I
|
|
End If
|
|
If sIdent = "" Then
|
|
If Len(sTag) > 0 Then
|
|
If sTag = "-" Then
|
|
sIdent = "DASH"
|
|
ElseIf sTag Like "[!A-Za-z0-9]" Then
|
|
sIdent = "BULLET"
|
|
ElseIf UCase(sTag) = "NOTE" Then
|
|
sIdent = "NOTE"
|
|
ElseIf UCase(sTag) = "CAUTION" Then
|
|
sIdent = "CAUTION"
|
|
ElseIf UCase(sTag) = "WARNING" Then
|
|
sIdent = "WARNING"
|
|
ElseIf InStr(sTag, ".") + InStr(sTag, ")") = 0 Then
|
|
sIdent = "PARAGRAPH"
|
|
Else
|
|
sIdent = "NUMBER"
|
|
End If
|
|
End If
|
|
ElseIf sIdent = "SECTION" Then
|
|
If ThisSection.ChangeNumber Then
|
|
sNewTag = sTag
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
GetIdent = sIdent
|
|
|
|
End Function
|
|
|
|
Public Function GetIdentOLD(ByVal para As Word.Range, Optional ByRef sNewTag As String = "") As String
|
|
Dim sTag As String
|
|
Dim sIdent As String
|
|
Dim sParaText As String
|
|
Dim I As Integer
|
|
|
|
sNewTag = ""
|
|
sParaText = CleanText(para.Text)
|
|
If CanIgnore(sParaText) = True Then
|
|
sIdent = "IGNORE"
|
|
Else
|
|
With para
|
|
sTag = .ListFormat.ListString
|
|
If sTag = "" Then
|
|
'not automatic numbering, so find the step number
|
|
For I = 1 To Len(sParaText)
|
|
If InStr(" " & Chr(9) & Chr(11) & Chr(13), Mid(.Text, I, 1)) > 0 Then
|
|
'searh up to the first space, tab, line feed or paragraph
|
|
Exit For
|
|
End If
|
|
sTag = sTag & Mid(.Text, I, 1)
|
|
Next I
|
|
End If
|
|
End With
|
|
|
|
sTag = Replace(sTag, "[", "")
|
|
sTag = Replace(sTag, "]", "")
|
|
|
|
On Error Resume Next
|
|
I = UBound(VESections)
|
|
If Err.Number <> 0 Then
|
|
GetSections
|
|
Err.Clear()
|
|
End If
|
|
On Error GoTo 0
|
|
|
|
For I = 0 To UBound(VESections)
|
|
If RegExMatch(sTag & sParaText, VESections(I).Pattern) = True Then
|
|
sIdent = "SECTION"
|
|
ThisSection = VESections(I)
|
|
Exit For
|
|
ElseIf RegExMatch(sTag, VESections(I).Pattern) = True Then
|
|
sIdent = "SECTION"
|
|
ThisSection = VESections(I)
|
|
ThisSection.number = sTag
|
|
Exit For
|
|
ElseIf VESections(I).number <> "" Then
|
|
If sTag = VESections(I).number Then
|
|
'tag matches a section number setting
|
|
If VESections(I).Title = "" Then
|
|
sIdent = "SECTION"
|
|
ThisSection = VESections(I)
|
|
Exit For
|
|
Else
|
|
'If InStr(para.Text, VESections(I).Title) > 0 Then
|
|
If sParaText Like VESections(I).Title & "*" Then
|
|
'section title is found in the paragraph text
|
|
sIdent = "SECTION"
|
|
ThisSection = VESections(I)
|
|
Exit For
|
|
End If
|
|
End If
|
|
End If
|
|
ElseIf VESections(I).Title = "" Then
|
|
'untitled section such as Attachment
|
|
If VESections(I).number <> "" Then
|
|
If sTag = VESections(I).number Then
|
|
sIdent = "SECTION"
|
|
ThisSection = VESections(I)
|
|
Exit For
|
|
End If
|
|
End If
|
|
ElseIf VESections(I).number = "" Then
|
|
'section has no number
|
|
If VESections(I).Title <> "" Then
|
|
'and section has title
|
|
'If InStr(para.Text, VESections(I).Title) > 0 Then
|
|
If sParaText Like VESections(I).Title & "*" Then
|
|
'section title is found in the paragraph text
|
|
sIdent = "SECTION"
|
|
ThisSection = VESections(I)
|
|
Exit For
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
Next I
|
|
|
|
If sIdent = "" Then
|
|
If Len(sTag) > 0 Then
|
|
If sTag = "-" Then
|
|
sIdent = "DASH"
|
|
ElseIf sTag Like "[!A-Za-z0-9]" Then
|
|
sIdent = "BULLET"
|
|
ElseIf UCase(sTag) = "NOTE" Then
|
|
sIdent = "NOTE"
|
|
ElseIf UCase(sTag) = "CAUTION" Then
|
|
sIdent = "CAUTION"
|
|
ElseIf UCase(sTag) = "WARNING" Then
|
|
sIdent = "WARNING"
|
|
ElseIf InStr(sTag, ".") + InStr(sTag, ")") = 0 Then
|
|
sIdent = "PARAGRAPH"
|
|
Else
|
|
sIdent = "NUMBER"
|
|
End If
|
|
End If
|
|
ElseIf sIdent = "SECTION" Then
|
|
If ThisSection.number = "" Then
|
|
sNewTag = sTag
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
GetIdentOLD = sIdent
|
|
|
|
End Function
|
|
|
|
Private Function CanIgnore(ByVal sText As String) As Boolean
|
|
Dim bReturn As Boolean
|
|
Dim I As Integer
|
|
|
|
bReturn = False
|
|
|
|
For I = 0 To UBound(IgnoreMe)
|
|
If IgnoreMe(I) <> "" Then
|
|
If RegExMatch(sText, IgnoreMe(I)) = True Then
|
|
bReturn = True
|
|
Exit For
|
|
End If
|
|
End If
|
|
Next I
|
|
|
|
CanIgnore = bReturn
|
|
End Function
|
|
|
|
Public Sub GetSection()
|
|
Dim R1 As Word.Range
|
|
Dim R2 As Word.Range
|
|
Dim sID As String
|
|
|
|
'Exit Sub
|
|
|
|
R1 = GetComment(App.Selection.Range)
|
|
If Not R1 Is Nothing Then
|
|
If R1.Comments(1).Author = "SECTION" Then
|
|
sID = R1.Paragraphs(R1.Paragraphs.Count).Range.Text
|
|
End If
|
|
End If
|
|
|
|
If sID = "" Then
|
|
If App.Selection.Information(Word.WdInformation.wdInCommentPane) = True Then
|
|
R1 = App.Selection.Range.Comments(1).Scope
|
|
Else
|
|
R1 = App.ActiveDocument.Range(App.Selection.Start, App.Selection.End)
|
|
End If
|
|
|
|
R2 = R1.GoTo(What:=Word.WdGoToItem.wdGoToComment, Which:=Word.WdGoToDirection.wdGoToPrevious, Name:="SECTION")
|
|
R1 = GetComment(R2)
|
|
If Not R1 Is Nothing Then
|
|
sID = R1.Paragraphs(R1.Paragraphs.Count).Range.Text
|
|
End If
|
|
End If
|
|
|
|
If sID <> ThisSection.ID Then
|
|
If IsNumeric(sID) Then
|
|
ThisSection = VESections(CInt(sID))
|
|
End If
|
|
End If
|
|
End Sub
|
|
Private Function GetLevelStep(ByVal para As Word.Range, ByRef LastMargin As Single, ByRef LastLevel As Integer, Optional StartAt As Integer = 0) As Integer
|
|
Dim sTag As String
|
|
Dim dL As Integer 'change in level
|
|
Dim iLevel As Integer
|
|
Dim sngMargin As Single
|
|
|
|
sngMargin = para.ParagraphFormat.LeftIndent
|
|
iLevel = GetLevelByDef(para, StartAt)
|
|
|
|
If iLevel = 0 Then
|
|
With para
|
|
sTag = .ListFormat.ListString
|
|
If sTag = "" Then
|
|
sTag = .Words(1).Text
|
|
End If
|
|
|
|
If sTag Like "*.0" Then
|
|
dL = 1
|
|
ElseIf sTag Like "*#" Then
|
|
dL = Len(sTag) - Len(Replace(sTag, ".", ""))
|
|
dL = dL + Len(sTag) - Len(Replace(sTag, ")", ""))
|
|
dL = dL - LastLevel
|
|
'If dL < -1 Then dL = -1
|
|
If dL > 1 Then dL = 1
|
|
Else
|
|
'iLevel = .ListFormat.ListLevelNumber
|
|
If sngMargin > LastMargin Then
|
|
dL = 1
|
|
ElseIf sngMargin < LastMargin Then
|
|
dL = -1
|
|
Else
|
|
dL = 0
|
|
End If
|
|
End If
|
|
End With
|
|
iLevel = LastLevel + dL
|
|
Else
|
|
iLevel = iLevel - ThisSection.StepOffset
|
|
End If
|
|
|
|
LastMargin = sngMargin
|
|
LastLevel = iLevel
|
|
|
|
GetLevelStep = iLevel
|
|
|
|
End Function
|
|
|
|
Private Function GetLevelPara(ByVal para As Word.Range, ByRef LastMargin As Single, ByRef LastLevel As Integer) As Integer
|
|
Dim dL As Integer 'change in level
|
|
Dim iLevel As Integer
|
|
Dim sngMargin As Single
|
|
|
|
sngMargin = para.ParagraphFormat.LeftIndent
|
|
|
|
If sngMargin > LastMargin Then
|
|
dL = 1
|
|
ElseIf sngMargin < LastMargin Then
|
|
dL = -1
|
|
Else
|
|
dL = 0
|
|
End If
|
|
|
|
LastMargin = sngMargin
|
|
|
|
iLevel = LastLevel + dL
|
|
LastLevel = iLevel
|
|
|
|
|
|
LastMargin = sngMargin
|
|
LastLevel = iLevel
|
|
|
|
GetLevelPara = iLevel
|
|
|
|
End Function
|
|
|
|
Public Function RegExMatch(ByVal myString As String, ByVal myPattern As String) As Boolean
|
|
Dim bReturn As Boolean
|
|
Dim oRE As RegExp
|
|
|
|
On Error Resume Next
|
|
|
|
bReturn = False
|
|
If myPattern <> "" Then
|
|
oRE = New RegExp
|
|
oRE.IgnoreCase = False
|
|
oRE.Global = False
|
|
oRE.Pattern = myPattern
|
|
|
|
bReturn = oRE.Test(myString)
|
|
End If
|
|
|
|
RegExMatch = bReturn
|
|
|
|
End Function
|
|
|
|
Private Function GetLevelByDef(ByVal para As Word.Range, ByVal StartAt As Integer) As Integer
|
|
Dim sTemp As String
|
|
Dim I As Integer
|
|
Dim J As Integer
|
|
Dim iReturn As Integer
|
|
|
|
iReturn = 0
|
|
|
|
'On Error Resume Next
|
|
|
|
sTemp = para.ListFormat.ListString
|
|
If sTemp = "" Then
|
|
sTemp = para.Text
|
|
Else
|
|
sTemp = sTemp & Chr(9) & para.Text
|
|
End If
|
|
|
|
With ThisSection.StepStyle
|
|
J = UBound(.LevelDefs)
|
|
For I = StartAt To UBound(.LevelDefs)
|
|
If RegExMatch(sTemp, .LevelDefs(I).Def) = True Then
|
|
iReturn = .LevelDefs(I).Level
|
|
Exit For
|
|
End If
|
|
Next I
|
|
End With
|
|
|
|
GetLevelByDef = iReturn
|
|
|
|
End Function
|
|
|
|
Private Function GetSep(ByVal para As Word.Range) As String
|
|
Dim sSep As String
|
|
Dim sTextAfter As String
|
|
Dim sTextBefore As String
|
|
Dim I As Integer
|
|
|
|
If para.Previous(Unit:=Word.WdUnits.wdParagraph, Count:=1).Words.Count < 3 Then
|
|
sTextBefore = para.Previous(Unit:=Word.WdUnits.wdParagraph, Count:=1).Text
|
|
sTextBefore = Replace(sTextBefore, Chr(9), "")
|
|
sTextBefore = Replace(sTextBefore, Chr(11), "")
|
|
sTextBefore = Replace(sTextBefore, Chr(13), "")
|
|
Else
|
|
sTextBefore = ""
|
|
End If
|
|
If para.Next(Unit:=Word.WdUnits.wdParagraph, Count:=1).Words.Count < 3 Then
|
|
sTextAfter = para.Next(Unit:=Word.WdUnits.wdParagraph, Count:=1).Text
|
|
sTextAfter = Replace(sTextAfter, Chr(9), "")
|
|
sTextAfter = Replace(sTextAfter, Chr(11), "")
|
|
sTextAfter = Replace(sTextAfter, Chr(13), "")
|
|
Else
|
|
sTextAfter = ""
|
|
End If
|
|
|
|
sSep = ""
|
|
GetSeparators
|
|
For I = 0 To UBound(Separators)
|
|
If Separators(I) <> "" Then
|
|
If (sTextBefore Like "*" & Separators(I) & "*") Or (sTextAfter Like "*" & Separators(I) & "*") Then
|
|
sSep = Separators(I)
|
|
Exit For
|
|
End If
|
|
End If
|
|
Next I
|
|
|
|
GetSep = sSep
|
|
|
|
End Function
|
|
|
|
Public Function MoveNext(Optional SearchRange As Word.Range) As Boolean
|
|
Dim bReturn As Boolean
|
|
Dim rng As Word.Range
|
|
|
|
If SearchRange Is Nothing Then
|
|
SearchRange = App.ActiveDocument.Content
|
|
End If
|
|
|
|
With App.Selection
|
|
'move out of comment into main story
|
|
If .Information(wdInCommentPane) Then
|
|
.Comments(1).Scope.Select()
|
|
End If
|
|
|
|
'save location of original selection
|
|
rng = .Range.Duplicate
|
|
|
|
If .End < SearchRange.End Then
|
|
If .Information(wdWithInTable) = True Then
|
|
.Collapse Direction:=wdCollapseEnd
|
|
.Expand Unit:=wdParagraph
|
|
Else
|
|
'.Collapse Direction:=wdCollapseStart
|
|
'.Move unit:=wdParagraph, Count:=1
|
|
.Collapse Direction:=wdCollapseEnd
|
|
.Move Unit:=wdCharacter, Count:=1
|
|
.Expand Unit:=wdParagraph
|
|
End If
|
|
|
|
'don't get stuck in a field code, such as TOC
|
|
If .Information(wdInFieldCode) = True Or .Information(wdInFieldResult) = True Then
|
|
While .Information(wdInFieldCode) = True Or .Information(wdInFieldResult) = True
|
|
.Move Unit:=wdParagraph, Count:=1
|
|
End While
|
|
.Collapse Direction:=wdCollapseStart
|
|
.Expand Unit:=wdParagraph
|
|
End If
|
|
|
|
If .Information(wdWithInTable) = True Then
|
|
.Expand Unit:=wdTable
|
|
Else
|
|
.Expand Unit:=wdParagraph
|
|
'skip over blank paragraphs
|
|
Do While (.Range.Text = Chr(13)) And (.End < App.ActiveDocument.Content.End)
|
|
If .Move(Unit:=wdParagraph, Count:=1) = 0 Then
|
|
Exit Do
|
|
End If
|
|
.Expand Unit:=wdParagraph
|
|
Loop
|
|
Do While (.Range.Characters(1) = Chr(12)) And (.Start < .End)
|
|
.Start = .Start + 1
|
|
Loop
|
|
|
|
End If
|
|
If rng.Start = .Start And rng.End = .End Then
|
|
'new selection is same as old selection
|
|
bReturn = False
|
|
Else
|
|
'something new has been selected
|
|
bReturn = True
|
|
End If
|
|
Else
|
|
bReturn = False
|
|
End If
|
|
|
|
ActiveWindow.ScrollIntoView.Range
|
|
DoEvents
|
|
End With
|
|
|
|
MoveNext = bReturn
|
|
|
|
End Function
|
|
|
|
Public Function MoveNextCellPara(ByRef C As Cell) As Boolean
|
|
Dim bReturn As Boolean
|
|
Dim rng As Range
|
|
|
|
If Not C Is Nothing Then
|
|
With App.Selection
|
|
'save location of original selection
|
|
rng = .Range.Duplicate
|
|
|
|
If .End < C.Range.End Then
|
|
'.Collapse Direction:=wdCollapseStart
|
|
'.Move unit:=wdParagraph, Count:=1
|
|
.Collapse Direction:=wdCollapseEnd
|
|
.Move Unit:=wdCharacter, Count:=1
|
|
.Expand Unit:=wdParagraph
|
|
|
|
'skip over blank paragraphs
|
|
Do While (.Range.Text = vbCr) And (.End < C.Range.End)
|
|
If .Move(Unit:=wdParagraph, Count:=1) = 0 Then
|
|
Exit Do
|
|
End If
|
|
Loop
|
|
Do While (.Range.Characters(1) = Chr(12)) And (.Start < .End)
|
|
.Start = .Start + 1
|
|
Loop
|
|
|
|
'move back from end of cell marker
|
|
Do While .Paragraphs.Count > 1 And (.Start < .End)
|
|
.End = .End - 1
|
|
Loop
|
|
|
|
'move start past any field codes
|
|
Do While (.Range.Characters(1).Information(wdInFieldCode) = True Or .Range.Characters(1).Information(wdInFieldResult) = True) And (.Start < .End)
|
|
.Start = .Start + 1
|
|
Loop
|
|
|
|
If rng.Start = .Start And rng.End = .End Then
|
|
'new selection is same as old selection
|
|
bReturn = False
|
|
Else
|
|
'something new has been selected
|
|
bReturn = True
|
|
End If
|
|
Else
|
|
bReturn = False
|
|
End If
|
|
|
|
ActiveWindow.ScrollIntoView.Range
|
|
DoEvents
|
|
End With
|
|
Else
|
|
bReturn = False
|
|
End If
|
|
|
|
MoveNextCellPara = bReturn
|
|
|
|
End Function
|
|
|
|
Public Function MovePrevious(Optional SelectCmt As Boolean = False) As Boolean
|
|
Dim bReturn As Boolean
|
|
Dim rng As Range
|
|
|
|
With App.Selection
|
|
rng = .Range.Duplicate
|
|
If .Information(wdInCommentPane) Then
|
|
.Comments(1).Scope.Select()
|
|
End If
|
|
If .Start > App.ActiveDocument.Content.Start Then
|
|
.Collapse Direction:=wdCollapseStart
|
|
.Move Unit:=wdParagraph, Count:=-1
|
|
.Expand Unit:=wdParagraph
|
|
While .Information(wdWithInTable) = False And .Range.Text = Chr(13)
|
|
.Move Unit:=wdParagraph, Count:=-2
|
|
.Expand Unit:=wdParagraph
|
|
End While
|
|
If .Information(wdWithInTable) = True Then
|
|
.Expand Unit:=wdTable
|
|
End If
|
|
End If
|
|
If rng.Start = .Start And rng.End = .End Then
|
|
bReturn = False
|
|
Else
|
|
bReturn = True
|
|
End If
|
|
ActiveWindow.ScrollIntoView.Range
|
|
End With
|
|
If SelectCmt Then
|
|
GoToComment()
|
|
End If
|
|
MovePrevious = bReturn
|
|
|
|
End Function
|
|
|
|
Public Sub WhatIsThis()
|
|
Dim sParaText As String
|
|
Dim sIdent As String
|
|
Static LastMargin As Single
|
|
Static LastLevel As Integer
|
|
|
|
With App.Selection
|
|
If .Information(wdWithInTable) = True Then
|
|
If .Tables(1).Rows.Count = 1 And .Tables(1).Columns.Count = 1 Then
|
|
'Note/Caution/Warning
|
|
NoteFromTable.Tables(1)
|
|
Else
|
|
'imbedded table has been found
|
|
'InsertComment "TABLE"
|
|
FlagTable()
|
|
End If
|
|
ElseIf .Information(wdFrameIsSelected) = True Then
|
|
FlagFigure()
|
|
ElseIf .Information(wdInFieldCode) = True Then
|
|
'do nothing
|
|
ElseIf .Information(wdInFieldResult) = True Then
|
|
'do nothing
|
|
Else
|
|
'sParaText = CleanText(.Text)
|
|
'If (sParaText <> "") Then
|
|
sIdent = GetIdent(.Range)
|
|
Select Case sIdent
|
|
Case "IGNORE"
|
|
InsertComment "IGNORE"
|
|
Case "NOTE", "CAUTION"
|
|
ThisIdent = sIdent
|
|
FlagStep()
|
|
End Select
|
|
'End If
|
|
End If
|
|
End With
|
|
|
|
End Sub
|
|
|
|
Private Function NameFromShape(ByVal shp As Shape) As String
|
|
'Mark a text box shape as a Note/Caution/Warning
|
|
Dim sReturn As String 'Note/Caution/Warning/Hold
|
|
|
|
With shp.TextFrame.TextRange
|
|
sReturn = CleanText(.Paragraphs(1).Range.Text)
|
|
If InStr(sReturn, " ") > 0 Then
|
|
sReturn = Left(sReturn, InStr(sReturn, " ") - 1)
|
|
End If
|
|
sReturn = UCase(sReturn)
|
|
If Right(sReturn, 1) = "S" Then
|
|
sReturn = Left(sReturn, Len(sReturn) - 1)
|
|
End If
|
|
End With
|
|
|
|
NameFromShape = sReturn
|
|
|
|
End Function
|
|
|
|
Private Sub NoteFromTable(ByVal tbl As Table)
|
|
'Mark text within a Word table (tbl) as a Note/Caution/Warning/Hold
|
|
Dim sHeader As String 'Note/Caution/Warning/Hold
|
|
Dim sID As String
|
|
Dim rng As Range
|
|
Dim LeftMargin As Single
|
|
Dim iStart As Long
|
|
Dim iEnd As Long
|
|
Dim I As Integer
|
|
|
|
With tbl.Range
|
|
If .Paragraphs.Count > 1 Then
|
|
sHeader = CleanText(.Paragraphs(1).Range.Text)
|
|
sHeader = Replace(sHeader, " ", "")
|
|
sHeader = UCase(sHeader)
|
|
|
|
If Right(sHeader, 1) = "S" Then
|
|
sHeader = Left(sHeader, Len(sHeader) - 1)
|
|
End If
|
|
sID = GetDefault(sHeader)
|
|
If sID <> "" Then
|
|
|
|
.Select()
|
|
RemoveComments()
|
|
|
|
LeftMargin = .Paragraphs(2).Range.ParagraphFormat.LeftIndent
|
|
|
|
.Paragraphs(2).Range.Select()
|
|
App.Selection.MoveEndWhile Cset:=Chr(13) & Chr(7), Count:=wdBackward
|
|
App.Selection.Start = .Paragraphs(2).Range.Start
|
|
|
|
For I = 3 To .Paragraphs.Count - 1
|
|
If Len(.Paragraphs(I).Range.Text) > 2 Then
|
|
'this para has text
|
|
|
|
If .Paragraphs(I).Range.ParagraphFormat.LeftIndent > LeftMargin Then
|
|
'substep of note found so include it in previous selection
|
|
iStart = App.Selection.Start
|
|
App.Selection.End = .Paragraphs(I).Range.End
|
|
App.Selection.MoveEndWhile Cset:=Chr(13) & Chr(7), Count:=wdBackward
|
|
App.Selection.Start = iStart
|
|
Else
|
|
'new note found, so save the previous note
|
|
If Len(App.Selection.Text) > 1 Then
|
|
FlagStep sID
|
|
End If
|
|
'select the new note
|
|
.Paragraphs(I).Range.Select()
|
|
App.Selection.MoveEndWhile Cset:=Chr(13) & Chr(7), Count:=wdBackward
|
|
App.Selection.Start = .Paragraphs(I).Range.Start
|
|
End If
|
|
Else
|
|
'blank paragraph found, so save previous note
|
|
If Len(App.Selection.Text) > 1 Then
|
|
FlagStep sID
|
|
End If
|
|
If I < .Paragraphs.Count Then
|
|
'move selection to start of next paragraph
|
|
App.Selection.Start = .Paragraphs(I + 1).Range.Start
|
|
App.Selection.End = App.Selection.Start
|
|
End If
|
|
End If
|
|
Next I
|
|
If Len(App.Selection.Text) > 1 Then
|
|
FlagStep sID
|
|
End If
|
|
End If
|
|
End If
|
|
End With
|
|
|
|
tbl.Select()
|
|
|
|
End Sub
|
|
|
|
|
|
Private Function ConvertTableDef(ByVal tbl As Table) As String
|
|
'Converts a Word table (tbl) to an XML string
|
|
Dim sReturn As String 'string returned from this function
|
|
Dim sTemp As String 'string used for temporary storage
|
|
Dim sXML As String 'XML string being created
|
|
Dim iRow As Integer 'active index into table rows collection
|
|
Dim iCol As Integer 'active index into table columns collection
|
|
Dim I As Integer 'counter
|
|
|
|
Dim cw As Single 'temporary value of cell width
|
|
Dim w As Single 'temporary value of cell width
|
|
Dim Wcol() As Single 'width of each column in table
|
|
Dim Wcell() As Integer 'width of each cell in table
|
|
Dim spanC() As Integer 'column span
|
|
Dim spanR() As Integer 'row span
|
|
Dim MergeCount As Integer 'count of merged cells
|
|
|
|
'ignore errors if any cell is undefined
|
|
On Error Resume Next
|
|
|
|
'size valriables to match table row and column dimensions
|
|
ReDim Wcol(tbl.Columns.Count)
|
|
ReDim Wcell(tbl.Rows.Count, tbl.Columns.Count)
|
|
ReDim spanC(tbl.Rows.Count, tbl.Columns.Count)
|
|
ReDim spanR(tbl.Rows.Count, tbl.Columns.Count)
|
|
|
|
|
|
For iCol = 1 To tbl.Columns.Count
|
|
Wcol(iCol) = tbl.Columns.Width
|
|
For iRow = 1 To tbl.Rows.Count
|
|
'start with a width of zero
|
|
w = 0
|
|
'if cell is undefined this next line will error but w will remain equal to zero
|
|
w = tbl.Cell(iRow, iCol).Width
|
|
|
|
'convert points to pixels
|
|
Wcell(iRow, iCol) = Int((w * 8) / 6)
|
|
|
|
cw = Wcol(iCol)
|
|
cw = tbl.Cell(iRow, iCol).Width
|
|
|
|
'convert points to pixels
|
|
cw = Int((cw * 8) / 6)
|
|
|
|
If Wcol(iCol) > 0 Then
|
|
If cw < Wcol(iCol) Then
|
|
Wcol(iCol) = cw
|
|
End If
|
|
Else
|
|
Wcol(iCol) = cw
|
|
End If
|
|
Next iRow
|
|
Next iCol
|
|
|
|
'roll up column spans
|
|
For iRow = 1 To tbl.Rows.Count
|
|
MergeCount = 1
|
|
For iCol = tbl.Columns.Count To 1 Step -1
|
|
If Wcell(iRow, iCol) > 0 Then
|
|
'this is a valid cell
|
|
If Wcell(iRow, iCol) - Wcol(iCol) > 0 Then
|
|
'this cell spans more than one column so set its span to mergecount
|
|
spanC(iRow, iCol) = MergeCount
|
|
End If
|
|
While MergeCount > 1
|
|
'flag merged cells cells so they are not merged vertically
|
|
MergeCount = MergeCount - 1
|
|
spanC(iRow, iCol + MergeCount) = 1
|
|
End While
|
|
spanC(iRow, iCol) = 1
|
|
MergeCount = 1
|
|
Else
|
|
'cell is undefined so add it to mergecount
|
|
MergeCount = MergeCount + 1
|
|
'flag this cell as capable of vertical merging
|
|
spanC(iRow, iCol) = 0
|
|
End If
|
|
Next iCol
|
|
Next iRow
|
|
|
|
'roll up row spans
|
|
For iCol = 1 To tbl.Columns.Count
|
|
MergeCount = 1
|
|
For iRow = tbl.Rows.Count To 1 Step -1
|
|
If spanC(iRow, iCol) = 0 Then
|
|
'cell is undefined and not merged horizontally so add it to mergecount
|
|
MergeCount = MergeCount + 1
|
|
Else
|
|
'cell is valid so set its span
|
|
spanR(iRow, iCol) = MergeCount
|
|
MergeCount = 1
|
|
End If
|
|
Next iRow
|
|
Next iCol
|
|
|
|
'build xml for this table
|
|
sXML = "<table>"
|
|
For iRow = 1 To tbl.Rows.Count
|
|
sXML = sXML & "<tr>"
|
|
For iCol = 1 To tbl.Columns.Count
|
|
With tbl.Cell(iRow, iCol)
|
|
If Wcell(iRow, iCol) <> 0 Then
|
|
sXML = sXML & "<td"
|
|
If spanR(iRow, iCol) > 1 Then
|
|
sXML = sXML & " rowspan=" & Chr(34) & spanR(iRow, iCol) & Chr(34)
|
|
ElseIf spanC(iRow, iCol) > 1 Then
|
|
sXML = sXML & " colspan=" & Chr(34) & spanC(iRow, iCol) & Chr(34)
|
|
ElseIf Wcol(iCol) > 0 Then
|
|
sXML = sXML & " width=" & Chr(34) & Wcol(iCol) & Chr(34)
|
|
Wcol(iCol) = Wcol(iCol) * -1
|
|
End If
|
|
sXML = sXML & ">"
|
|
|
|
For I = 1 To .Range.Paragraphs.Count
|
|
sTemp = .Range.Paragraphs(I).Range.Text
|
|
sTemp = CleanText(sTemp)
|
|
If sTemp <> "" Then
|
|
sXML = sXML & "<p>" & sTemp & "</p>"
|
|
End If
|
|
Next I
|
|
sXML = sXML & "</td>"
|
|
End If
|
|
End With
|
|
Next iCol
|
|
sXML = sXML & "</tr>"
|
|
Next iRow
|
|
sXML = sXML & "</table>"
|
|
|
|
sReturn = sXML
|
|
|
|
ConvertTableDef = sReturn
|
|
End Function
|
|
|
|
Private Function CleanText(ByVal sText As String, Optional MarkLineFeed As Boolean = False) As String
|
|
Dim sReturn As String
|
|
|
|
sReturn = sText
|
|
|
|
sReturn = Replace(sReturn, Chr(7), "@") 'tab
|
|
sReturn = Replace(sReturn, Chr(13), "@") 'paragraph mark
|
|
|
|
'check mark in parenthesis
|
|
sReturn = Replace(sReturn, "(" & ChrW(-4016) & ")", "(✓)")
|
|
'hard hyphen to regular hyphen
|
|
sReturn = Replace(sReturn, Chr(30), Chr(45))
|
|
'line feed
|
|
sReturn = Replace(sReturn, Chr(12), "")
|
|
sReturn = Replace(sReturn, Chr(11), "")
|
|
'hard space
|
|
sReturn = Replace(sReturn, Chr(160), " ")
|
|
|
|
'strip off signature lines
|
|
sReturn = Replace(sReturn, vbTab & "Initials", "")
|
|
sReturn = Replace(sReturn, "Initials", "")
|
|
sReturn = Replace(sReturn, vbTab & "Initial", "")
|
|
sReturn = Replace(sReturn, "Initial", "")
|
|
sReturn = Replace(sReturn, vbTab & "_", "")
|
|
sReturn = Replace(sReturn, "_", "")
|
|
|
|
'always remove markers at end of text
|
|
While Right(sReturn, 1) = "@"
|
|
sReturn = Left(sReturn, Len(sReturn) - 1)
|
|
End While
|
|
|
|
'if desired flag internal markers with forward slash
|
|
If MarkLineFeed = True Then
|
|
sReturn = Replace(sReturn, "@", " / ")
|
|
Else
|
|
sReturn = Replace(sReturn, "@", " ")
|
|
End If
|
|
|
|
'remove surrounding spaces
|
|
sReturn = Trim(sReturn)
|
|
|
|
CleanText = sReturn
|
|
End Function
|
|
|
|
Public Sub MarkCheckoff(sTag As String)
|
|
With App.Selection
|
|
.Text = ""
|
|
.Expand Unit:=wdParagraph
|
|
.End = .End - 1
|
|
.Collapse Direction:=wdCollapseEnd
|
|
.Text = "<" & sTag & ">"
|
|
End With
|
|
End Sub
|
|
|
|
Public Sub ReplaceCheckoff(sTag As String)
|
|
Dim sMsg As String
|
|
Dim sFind As String
|
|
|
|
With App.Selection
|
|
sFind = .Text
|
|
MarkCheckoff sTag
|
|
If .Tables.Count + .InlineShapes.Count + .Frames.Count = 0 Then
|
|
If sFind <> "" Then
|
|
App.Selection.Find.ClearFormatting()
|
|
App.Selection.Find.Replacement.ClearFormatting()
|
|
|
|
With App.Selection.Find
|
|
.Forward = True
|
|
.Wrap = wdFindContinue
|
|
.Format = False
|
|
.MatchCase = False
|
|
.MatchWholeWord = False
|
|
.MatchWildcards = False
|
|
.MatchSoundsLike = False
|
|
.MatchAllWordForms = False
|
|
End With
|
|
While App.Selection.Find.Execute(FindText:=sFind) = True
|
|
MarkCheckoff sTag
|
|
End While
|
|
End If
|
|
End If
|
|
End With
|
|
|
|
End Sub
|
|
|
|
Public Sub SaveCheckoff(sFmtFile As String, sID As String)
|
|
'SAVE CHECKOFF AS BUILDING BLOCK ENTRY
|
|
Dim tmp As Template
|
|
Dim sNames As String
|
|
Dim sNewName As String
|
|
Dim sCategory As String
|
|
Dim bbE As BuildingBlock
|
|
Dim I As Integer
|
|
|
|
With App.Selection
|
|
If .Tables.Count + .InlineShapes.Count = 0 Then
|
|
sCategory = "CO_" & sFmtFile & "(" & sID & ")"
|
|
|
|
On Error Resume Next
|
|
tmp = ThisDocument.AttachedTemplate
|
|
With tmp.BuildingBlockEntries
|
|
For I = 1 To .Count
|
|
If .Item(I).Type = wdTypeAutoText Then
|
|
If .Item(I).Category = sCategory Then
|
|
sNames = sNames & ";" & .Item(I).Name & ";"
|
|
If .Item(I).Value = App.Selection.FormattedText Then
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
End If
|
|
Next I
|
|
End With
|
|
|
|
I = 65 'start with capital A
|
|
sNewName = sCategory & "." & Chr(I)
|
|
While InStr(sNames, ";" & sNewName & ";") > 0
|
|
I = I + 1
|
|
sNewName = sCategory & "." & Chr(I)
|
|
End While
|
|
|
|
tmp.BuildingBlockEntries.Add Name:=sNewName, Type:=wdTypeAutoText, Category:=sCategory, Range:= .Range
|
|
End If
|
|
End With
|
|
|
|
End Sub
|
|
|
|
Public Sub SearchCheckoff(sFmtFile As String, Optional sID As String = "")
|
|
'NOT TESTED, ONLY FINDS TEXT NOT SHAPES
|
|
Dim tmp As Template
|
|
Dim sNames As String
|
|
Dim sCategory As String
|
|
Dim bbE As BuildingBlock
|
|
Dim I As Integer
|
|
|
|
sCategory = "CO_" & sFmtFile & "("
|
|
If sID <> "" Then
|
|
sCategory = sCategory & sID & ")"
|
|
End If
|
|
sCategory = sCategory & "*"
|
|
|
|
tmp = ThisDocument.AttachedTemplate
|
|
With tmp.BuildingBlockEntries
|
|
For I = 1 To .Count
|
|
If .Item(I).Type = wdTypeAutoText Then
|
|
If .Item(I).Category Like sCategory Then
|
|
App.Selection.Find.ClearFormatting()
|
|
App.Selection.Find.Replacement.ClearFormatting()
|
|
|
|
With App.Selection.Find
|
|
.Text = tmp.BuildingBlockEntries(I).value
|
|
.Replacement.Text = "<" & tmp.BuildingBlockEntries(I).Category & "." & tmp.BuildingBlockEntries(I).name
|
|
.Forward = True
|
|
.Wrap = wdFindContinue
|
|
.Format = False
|
|
.MatchCase = False
|
|
.MatchWholeWord = False
|
|
.MatchWildcards = False
|
|
.MatchSoundsLike = False
|
|
.MatchAllWordForms = False
|
|
End With
|
|
App.Selection.Find.Execute Replace:=Word.WdReplace.wdReplaceAll
|
|
End If
|
|
End If
|
|
Next I
|
|
End With
|
|
|
|
End Sub
|
|
|
|
End Module
|