317 lines
10 KiB
Plaintext
317 lines
10 KiB
Plaintext
VERSION 5.00
|
|
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} vlnNextROForm
|
|
Caption = "Find RO"
|
|
ClientHeight = 3390
|
|
ClientLeft = 45
|
|
ClientTop = 345
|
|
ClientWidth = 8010
|
|
OleObjectBlob = "vlnNextROForm.frx":0000
|
|
ShowModal = 0 'False
|
|
StartUpPosition = 1 'CenterOwner
|
|
End
|
|
Attribute VB_Name = "vlnNextROForm"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
|
|
|
|
|
|
|
|
Option Explicit
|
|
Dim ContinueProcessing As Boolean
|
|
|
|
Private Function GetNextField(fld As Field) As Field
|
|
Dim fldNext As Field
|
|
On Error GoTo ehNF
|
|
Set fldNext = fld.Next
|
|
While Not fldNext Is Nothing
|
|
Debug.Print "fldNext " + CStr(fldNext.Index)
|
|
If (Mid(fldNext.Code.Text, 1, 8) = " QUOTE <") Then
|
|
Set GetNextField = fldNext
|
|
Exit Function
|
|
End If
|
|
Set fldNext = fldNext.Next
|
|
Wend
|
|
Set GetNextField = fldNext
|
|
Exit Function
|
|
ehNF:
|
|
Set GetNextField = Nothing
|
|
Exit Function
|
|
End Function
|
|
Private Function GetPreviousField(fld As Field) As Field
|
|
Dim fldPrev As Field
|
|
On Error GoTo ehPF
|
|
Set fldPrev = fld.Previous
|
|
While Not fldPrev Is Nothing
|
|
Debug.Print "fldPrev " + CStr(fldPrev.Index)
|
|
If (Mid(fldPrev.Code.Text, 1, 8) = " QUOTE <") Then
|
|
Set GetPreviousField = fldPrev
|
|
Exit Function
|
|
End If
|
|
Set fldPrev = fldPrev.Previous
|
|
Wend
|
|
Set GetPreviousField = fldPrev
|
|
Exit Function
|
|
ehPF:
|
|
Set GetPreviousField = Nothing
|
|
Exit Function
|
|
End Function
|
|
Private Function GetNextText(fld As Field) As String
|
|
Dim fldNext As Field
|
|
Set fldNext = GetNextField(fld)
|
|
If fldNext Is Nothing Then
|
|
GetNextText = ""
|
|
Else
|
|
GetNextText = GetRO(fldNext.Code.Text)
|
|
End If
|
|
End Function
|
|
Private Function GetPreviousText(fld As Field) As String
|
|
Dim fldPrev As Field
|
|
Set fldPrev = GetPreviousField(fld)
|
|
If fldPrev Is Nothing Then
|
|
GetPreviousText = ""
|
|
Else
|
|
GetPreviousText = GetRO(fldPrev.Code.Text)
|
|
End If
|
|
End Function
|
|
Private Sub btnNext_Click()
|
|
' MousePointer = fmMousePointerHourGlass
|
|
' DoEvents
|
|
' Dim rng As Range
|
|
' Set rng = Selection.Range
|
|
' Dim strt As Long
|
|
' strt = rng.End
|
|
' rng.MoveEnd wdCharacter, ActiveDocument.Characters.Count
|
|
' 'Debug.Print str(rng.start) & " - " & str(rng.End)
|
|
' Dim flds As Fields
|
|
' Set flds = rng.Fields
|
|
' 'Debug.Print str(flds.Count) & " Fields"
|
|
' Dim fld As Field
|
|
' For Each fld In flds
|
|
' Dim txt As String
|
|
' txt = fld.Code.Text
|
|
' If (fld.Code.Start > strt And Mid(fld.Code.Text, 1, 8) = " QUOTE <") Then
|
|
' tbNext.Text = GetNextText(fld)
|
|
' tbPrevious.Text = GetPreviousText(fld)
|
|
' Dim myType As String
|
|
' Dim myRO As String
|
|
' Dim myTxt As String
|
|
' myType = GetType(txt)
|
|
' myRO = GetRO(txt)
|
|
' myTxt = GetTxt(txt)
|
|
' If myType = "STP" Then 'setpoint
|
|
' ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
|
|
' MousePointer = fmMousePointerDefault
|
|
' Exit Sub
|
|
' ElseIf myType = "MEL" Then 'equipment
|
|
'' If InStr(myRO, "\n") > 0 And InStr(myRO, myTxt) > 0 Then 'handle only \n for now and only if text is fullname
|
|
' Dim p As Integer
|
|
' p = InStr(myRO, "\")
|
|
' If p > 0 Then
|
|
' Dim s As String
|
|
' s = UCase(Mid(myRO, p + 1, 1))
|
|
' If InStr("NRD", s) > 0 Then
|
|
' ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
|
|
' MousePointer = fmMousePointerDefault
|
|
' Exit Sub
|
|
' End If
|
|
' End If
|
|
'' If InStr(myRO, "\n") > 0 Then 'handle \n name (short or full)
|
|
'' ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
|
|
'' MousePointer = fmMousePointerDefault
|
|
'' Exit Sub
|
|
'' End If
|
|
'' If InStr(myRO, "\r") > 0 Then 'handle \r room
|
|
'' ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
|
|
'' MousePointer = fmMousePointerDefault
|
|
'' Exit Sub
|
|
'' End If
|
|
'' If InStr(myRO, "\d") > 0 Then 'handle \d description
|
|
'' ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
|
|
'' MousePointer = fmMousePointerDefault
|
|
'' Exit Sub
|
|
'' End If
|
|
' ElseIf myType = "ARP" Then 'alarm
|
|
' ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
|
|
' MousePointer = fmMousePointerDefault
|
|
' Exit Sub
|
|
' End If
|
|
' End If
|
|
' Next
|
|
' tbRO.Text = ""
|
|
' tbText.Text = ""
|
|
' Beep
|
|
' MousePointer = fmMousePointerDefault
|
|
End Sub
|
|
Sub ProcessField(fld As Field, ro As String, txt As String, roPrev As String, roNext As String)
|
|
fld.Select
|
|
ActiveWindow.ScrollIntoView Selection.Range, True
|
|
Dim clipboard As MSForms.DataObject
|
|
Set clipboard = New MSForms.DataObject
|
|
Dim roText As String
|
|
If Left(ro, 4) = "<ARP" Then
|
|
roText = GetARPRO(ro, roPrev, roNext)
|
|
Else
|
|
roText = ro
|
|
End If
|
|
tbRO.Text = roText
|
|
tbText.Text = txt
|
|
clipboard.SetText tbRO.Text
|
|
clipboard.PutInClipboard
|
|
End Sub
|
|
Function GetARPRO(ro As String, roPrev As String, roNext As String) As String
|
|
'<ARP CDS-LT046-MED \n\H>
|
|
'<MEL FWS-PL-V037 \d>
|
|
'<ARP CDS-LT046-MED \t\h\1>
|
|
Dim roNum As String
|
|
Dim roFlag As String
|
|
roNum = Trim(Left(ro, InStr(ro, "\") - 1))
|
|
roFlag = Trim(Mid(ro, InStr(ro, "\")))
|
|
Dim roPNum As String
|
|
Dim roPFlag As String
|
|
If roPrev = "" Then
|
|
roPNum = roPrev
|
|
roPFlag = roPrev
|
|
Else
|
|
roPNum = Trim(Left(roPrev, InStr(roPrev, "\") - 1))
|
|
roPFlag = Trim(Mid(roPrev, InStr(roPrev, "\")))
|
|
End If
|
|
Dim roNNum As String
|
|
Dim roNFlag As String
|
|
If roNext = "" Then
|
|
roNNum = roNext
|
|
roNFlag = roNext
|
|
Else
|
|
roNNum = Trim(Left(roNext, InStr(roNext, "\") - 1))
|
|
roNFlag = Trim(Mid(roNext, InStr(roNext, "\")))
|
|
End If
|
|
If InStr(ro, "\h") > 0 Or InStr(ro, "\l") > 0 Then
|
|
GetARPRO = roNum + GetARPExt(roFlag) + " " + roFlag
|
|
ElseIf roNum = roNNum And InStr(roNext, "\h") > 0 Or InStr(roNext, "\l") > 0 Then
|
|
GetARPRO = roNum + GetARPExt(roNFlag) + " " + roFlag
|
|
ElseIf roNum = roPNum And InStr(roPrev, "\h") > 0 Or InStr(roPrev, "\l") > 0 Then
|
|
GetARPRO = roNum + GetARPExt(roPFlag) + " " + roFlag
|
|
Else
|
|
GetARPRO = ro
|
|
End If
|
|
'<ARP CDS-LT046-MED-HI1 \n\H>
|
|
End Function
|
|
Function GetARPExt(flg As String) As String
|
|
'\t\h\1
|
|
If InStr(flg, "\h") > 0 Then
|
|
GetARPExt = "-HI"
|
|
End If
|
|
If InStr(flg, "\l") > 0 Then
|
|
GetARPExt = "-LO"
|
|
End If
|
|
If InStr(flg, "\1") > 0 Then
|
|
GetARPExt = GetARPExt + "1"
|
|
ElseIf InStr(flg, "\2") > 0 Then
|
|
GetARPExt = GetARPExt + "2"
|
|
ElseIf InStr(flg, "\3") > 0 Then
|
|
GetARPExt = GetARPExt + "3"
|
|
End If
|
|
End Function
|
|
Function GetType(str As String) As String
|
|
Dim startpt As Integer
|
|
startpt = InStr(str, "<") + 1
|
|
GetType = Mid(str, startpt, 3)
|
|
End Function
|
|
Function GetRO(str As String) As String
|
|
Dim startpt As Integer
|
|
startpt = InStr(str, "<")
|
|
Dim endpt As Integer
|
|
endpt = InStr(str, ">")
|
|
GetRO = Mid(str, startpt, 1 + endpt - startpt)
|
|
End Function
|
|
Function GetTxt(txt As String) As String
|
|
txt = Replace(txt, Chr(30), "-")
|
|
Dim startpt As Integer
|
|
startpt = InStr(txt, ">""")
|
|
Dim endpt As Integer
|
|
endpt = InStr(txt, """<")
|
|
GetTxt = Mid(txt, startpt + 2, endpt - startpt - 2)
|
|
End Function
|
|
Sub ShowMyself()
|
|
vlnNextROForm.Show
|
|
End Sub
|
|
Public Sub btnNext2_Click()
|
|
ContinueProcessing = False
|
|
Dim fld As Field
|
|
Set fld = NextRO(Selection.NextField)
|
|
If fld Is Nothing Then
|
|
If ContinueProcessing Then
|
|
Exit Sub
|
|
End If
|
|
tbRO.Text = ""
|
|
tbText.Text = ""
|
|
Beep
|
|
MsgBox "No more ROs", vbOKOnly, "End of Document"
|
|
Exit Sub
|
|
End If
|
|
Debug.Print "btnNext2 " + CStr(fld.Index)
|
|
Dim txt As String
|
|
Dim myType As String
|
|
Dim myRO As String
|
|
Dim myTxt As String
|
|
txt = fld.Code.Text
|
|
tbNext.Text = GetNextText(fld)
|
|
tbPrevious.Text = GetPreviousText(fld)
|
|
myType = GetType(txt)
|
|
myRO = GetRO(txt)
|
|
myTxt = GetTxt(txt)
|
|
ProcessField fld, myRO, myTxt, tbPrevious.Text, tbNext.Text
|
|
End Sub
|
|
Private Function NextRO(fld As Field) As Field
|
|
Set NextRO = Nothing
|
|
'topOfNextRO:
|
|
While Not (fld Is Nothing)
|
|
On Error GoTo myEH
|
|
If Mid(fld.Code.Text, 1, 8) = " QUOTE <" Then
|
|
Dim txt As String
|
|
Dim myType As String
|
|
Dim myRO As String
|
|
txt = fld.Code.Text
|
|
If tbSearch.TextLength = 0 Or InStr(txt, tbSearch.Text) > 0 Then
|
|
myType = GetType(txt)
|
|
myRO = GetRO(txt)
|
|
If myType = "STP" Then 'setpoint
|
|
Set NextRO = fld
|
|
Exit Function
|
|
ElseIf myType = "MEL" Then 'equipment
|
|
Dim p As Integer
|
|
p = InStr(myRO, "\")
|
|
If p > 0 Then
|
|
Dim s As String
|
|
s = UCase(Mid(myRO, p + 1, 1))
|
|
If InStr("NRD", s) > 0 Then
|
|
Set NextRO = fld
|
|
Exit Function
|
|
End If
|
|
End If
|
|
ElseIf myType = "ARP" Then 'alarm
|
|
Set NextRO = fld
|
|
Exit Function
|
|
End If
|
|
End If
|
|
End If
|
|
Set fld = fld.Next
|
|
If fld Is Nothing Then
|
|
Set fld = Selection.NextField
|
|
End If
|
|
Wend
|
|
Exit Function
|
|
myEH:
|
|
ContinueProcessing = True
|
|
Application.OnTime DateAdd("s", 2, Now), "RunAgain"
|
|
Exit Function
|
|
' Set NextRO = NextRO(Selection.NextField)
|
|
' Exit Function
|
|
' Set fld = Selection.NextField
|
|
' GoTo topOfNextRO
|
|
End Function
|
|
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
|
|
Unload Me
|
|
End Sub
|