Public Function isOacs() As Boolean isOacs = ActiveDocument.AttachedTemplate Like "oacs*" End Function Public Function isOacsForm() isOacsForm = Left(ActiveDocument.name, 3) Like "PTO" Or Left(ActiveDocument.name, 3) Like "IFW" End Function Public Function hasMarkup() hasMarkup = (ActiveDocument.Comments.Count > 0) Or (ActiveDocument.Revisions.Count > 0) End Function
Function FindCommandBar(name As String) As CommandBar For Each FindCommandBar In CommandBars 'If Not FindCommandBar.name Is Empty Then If FindCommandBar.name Like name Then Exit Function Next FindCommandBar Set FindCommandBar = Nothing End Function Function FindCommandButton(bar As CommandBar, name As String) As CommandBarControl Dim combo As CommandBarComboBox For Each FindCommandButton In bar.Controls On Error Resume Next If unAmp(FindCommandButton.Caption) Like name Then Exit Function Next FindCommandButton Set FindCommandButton = Nothing Exit Function End Function
Working with numbers: you'll need these for the numbering rejections macros below, but they are also useful themselves. Formatselection will turn "1 5 3 2 4" into "1-5" much like the boxes on a 326 do. removeNumberSelection() will take the selection 1-5 and ask you what numbers to remove. If you say "3 4" it will change it to "1-2 and 5"
Function numbers2Collection(strInput As String) As Collection 'Dim groups As Integer 'Dim strInput As String 'strInput = "2 5 6,4, 10-13 and 1" Dim reg As New RegExp 'Dim addString As String Dim i As Integer, c As Integer Dim matches As MatchCollection Dim m As match Dim allNums As String Dim firstLast() As String 'Dim firstInGroup As Integer 'Dim lastInGroup As Integer Dim sorted As New Collection reg.Global = True reg.Pattern = "\d+-\d+" Set matches = reg.Execute(strInput) Dim mi As Integer For mi = matches.Count - 1 To 0 Step -1 Set m = matches(mi) allNums = "" firstLast = Split(m.Value, "-") For i = firstLast(0) To firstLast(1) allNums = allNums & " " & i Next i strInput = Left(strInput, m.FirstIndex) & allNums & Mid(strInput, m.FirstIndex + m.length + 1) Next mi reg.Pattern = "\d+" Set matches = reg.Execute(strInput) sorted.Add CInt(matches(0).Value) For i = 1 To matches.Count - 1 For c = 1 To sorted.Count If CInt(matches(i).Value) < sorted(c) Then sorted.Add CInt(matches(i).Value), Before:=c Exit For ElseIf c = sorted.Count Then sorted.Add CInt(matches(i).Value), After:=c Exit For End If Next c Next i Set numbers2Collection = sorted End Function Function formatNumbers(strInput As String) As String Dim groups As Integer 'Dim strInput As String 'strInput = "2 5 6,4, 10-13 and 1" 'Dim reg As New regexp Dim addString As String 'Dim i As Integer Dim c As Integer 'Dim matches As MatchCollection 'Dim m As match 'Dim allNums As String Dim firstLast() As String Dim firstInGroup As Integer Dim lastInGroup As Integer Dim sorted As Collection Set sorted = numbers2Collection(strInput) 'at this point all numbers are sorted and in the collection c = sorted.Count Do Until c <= 0 firstInGroup = sorted(c) lastInGroup = sorted(c) c = c - 1 If c > 0 Then Do While firstInGroup - 1 = sorted(c) firstInGroup = sorted(c) c = c - 1 If c = 0 Then Exit Do Loop End If ' add the addstring to the total string If firstInGroup = lastInGroup Then addString = firstInGroup Else addString = firstInGroup & "-" & lastInGroup Select Case groups Case 0 formatNumbers = addString Case 1 formatNumbers = addString & " and " & formatNumbers Case Else formatNumbers = addString & ", " & formatNumbers End Select groups = groups + 1 Loop Exit Function End Function Sub formatSelection() Dim list As New NumberList list.Create Selection.Text Selection.Text = list.toString End Sub Sub removeNumberSelection() Dim sorted As Collection Set sorted = numbers2Collection(Selection.Text) Dim strDel As String strDel = InputBox("What claims do you want to remove from the selection?") If strDel = "" Then Exit Sub Dim colDel As Collection Set colDel = numbers2Collection(strDel) Dim i As Integer Dim find As Integer For i = 1 To colDel.Count find = BinarySearchInt(sorted, colDel(i)) If find > 0 Then sorted.Remove find Next i Dim out As String out = "" For i = 1 To sorted.Count out = out & " " & sorted(i) Next i Selection.Text = formatNumbers(out) End Sub
Function BinarySearchInt(arr As Collection, ByVal search As Integer) As Long Dim Index As Long Dim first As Long Dim last As Long Dim middle As Long Dim inverseOrder As Boolean first = 1 last = arr.Count ' deduct direction of sorting inverseOrder = (arr(first) > arr(last)) ' assume searches failed BinarySearchInt = first - 1 Do middle = (first + last) \ 2 If arr(middle) = search Then BinarySearchInt = middle Exit Do ElseIf ((arr(middle) < search) Xor inverseOrder) Then first = middle + 1 Else last = middle - 1 End If Loop Until first > last End Function
You also need to add this class file and name it NumberList
Option Explicit Private sorted As Collection Public Sub Create(strInput As String) 'Dim groups As Integer 'Dim strInput As String 'strInput = "2 5 6,4, 10-13 and 1" Dim reg As New RegExp 'Dim addString As String Dim i As Integer, c As Integer Dim matches As MatchCollection Dim m As match Dim allNums As String Dim firstLast() As String 'Dim firstInGroup As Integer 'Dim lastInGroup As Integer Set sorted = New Collection reg.Global = True reg.Pattern = "\d+-\d+" Set matches = reg.Execute(strInput) For Each m In matches allNums = "" firstLast = Split(m.Value, "-") For i = firstLast(0) To firstLast(1) allNums = allNums & " " & i Next i strInput = Replace(strInput, m.Value, allNums) Next m reg.Pattern = "\d+" Set matches = reg.Execute(strInput) sorted.Add CInt(matches(0).Value) For i = 1 To matches.Count - 1 For c = 1 To sorted.Count If CInt(matches(i).Value) < sorted(c) Then sorted.Add CInt(matches(i).Value), Before:=c Exit For ElseIf c = sorted.Count Then sorted.Add CInt(matches(i).Value), After:=c Exit For End If Next c Next i End Sub Function toString() As String Dim groups As Integer 'Dim strInput As String 'strInput = "2 5 6,4, 10-13 and 1" 'Dim reg As New regexp Dim addString As String 'Dim i As Integer Dim c As Integer 'Dim matches As MatchCollection 'Dim m As match 'Dim allNums As String Dim firstLast() As String Dim firstInGroup As Integer Dim lastInGroup As Integer ' Dim sorted As Collection Dim formatNumbers As String ' Set sorted = numbers2Collection(strInput) 'at this point all numbers are sorted and in the collection c = sorted.Count Do Until c <= 0 firstInGroup = sorted(c) lastInGroup = sorted(c) c = c - 1 If c > 0 Then Do While firstInGroup - 1 = sorted(c) firstInGroup = sorted(c) c = c - 1 If c = 0 Then Exit Do Loop End If ' add the addstring to the total string If firstInGroup = lastInGroup Then addString = firstInGroup Else addString = firstInGroup & "-" & lastInGroup Select Case groups Case 0 formatNumbers = addString Case 1 formatNumbers = addString & " and " & formatNumbers Case Else formatNumbers = addString & ", " & formatNumbers End Select groups = groups + 1 Loop toString = formatNumbers Exit Function End Function Public Property Get length() As Integer sorted.Count End Property
Add this macro and a button to always put your signature in the box at the bottom of an action. Also won't sign if there are still unaccepted changes
Public Sub signRightPlace() Dim btnSig As Office.CommandBarButton Set btnSig = FindCommandButton(FindCommandBar("OACS"), "eSignature") If Not hasMarkup Then If Left(ActiveDocument.name, 3) Like "PTO" Or Left(ActiveDocument.name, 3) Like "IFW" Then btnSig.Execute Else Dim sigTable As Word.Table Dim endOfDoc As Range Set endOfDoc = ActiveDocument.Range(InStr(ActiveDocument.Range.Text, "For more information about the PAIR system, see http://pair-direct.uspto.gov"), ActiveDocument.Range.End) If endOfDoc.Tables.Count = 1 Then Set sigTable = endOfDoc.Tables(1) If sigTable.Rows.Count <> 1 Or sigTable.Columns.Count <> 2 Then GoTo stupid Else Set endOfDoc = endOfDoc.Paragraphs(1).Range Set sigTable = endOfDoc.Tables.Add(endOfDoc, 1, 2) sigTable.Range.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle End If If ActiveWindow.View = wdWebView Then ActiveWindow.View = wdPrintView sigTable.Cell(1, 2).Range.Select ActiveWindow.ScrollIntoView Selection btnSig.Execute End If Else MsgBox "has markup" End If Exit Sub stupid: MsgBox "really?" End SubOpen current application in eDan
Sub edanOpen() Dim fs As New FileSystemObject Dim f As Folder Set f = fs.GetFolder(ActiveDocument.Path) Set f = f.ParentFolder Dim appNo As String 'now we've got the last three digits for network OR the whole thing appNo = getCurrentAppNum ChDrive "c" ChDir "C:\Program Files (x86)\eDAN" Debug.Print CurDir Shell "eDAN_API.cmd ""edan:openapp(appid=""" & appNo & """)""" End Sub Public Function getCurrentAppNum() Dim fs As New FileSystemObject Dim f As Folder Set f = fs.GetFolder(ActiveDocument.Path) Set f = f.ParentFolder If Len(f.name) = 3 Then getCurrentAppNum = f.ParentFolder.ParentFolder.name & f.ParentFolder.name & f.name ElseIf Len(f.name) = 8 Then getCurrentAppNum = f.name Else Err.Raise vbError + 2, , "can't program" End If End Function
Add classy line numbers to replace OACS's broken paragraph numbering
Sub OacsNum2LineNums() Dim p As Paragraph For Each p In ActiveDocument.Paragraphs If p.Range.ListFormat.ListType <> wdListNoNumbering Then p.Range.ListFormat.RemoveNumbers p.Range.InsertBefore vbTab End If Next p With ActiveDocument.PageSetup.LineNumbering .Active = True .CountBy = 5 .RestartMode = wdRestartPage End With End Sub
Add this as well if you want to always remember to do this when you close the document, should only ask when you are working on your own OACS correspondence
Sub autoclose() If isOacs Then If Not isOacsForm Then If ActiveDocument.Path Like "c:\*" Then If ActiveDocument.PageSetup.LineNumbering.Active = False Then Dim r As VbMsgBoxResult r = MsgBox("No line numbers detected. Run Oacs2LineNumbers?", vbYesNo, "Close Doc") If r = vbYes Then OacsNum2LineNums End If End If End If End If End Sub
For making amendments, turn on track changes, make changes, and then run this macro. The tracked changes will change to 1.121 compliant markup.
Sub amd() Const rule121 = 5 Dim doc As Document Dim rev As Revision Dim tRange As Range Set doc = ActiveDocument doc.TrackRevisions = False For Each rev In doc.Revisions Select Case rev.Type 'Only include insertions and deletions Case wdRevisionInsert rev.Range.Underline = wdUnderlineDouble rev.Range.Bold = True rev.Range.Font.Color = wdColorRed rev.accept Case wdRevisionDelete If rev.Range.Characters.Count > rule121 Then rev.Range.Font.StrikeThrough = True rev.Range.Font.Color = wdColorBlue rev.Reject Else Set tRange = rev.Range rev.Reject 'tRange.Font.Color = wdColorBlue tRange.InsertAfter "]]" tRange.InsertBefore "[[" tRange.Font.Color = wdColorBlue End If End Select Next rev Set tRange = Nothing Set doc = Nothing Set rev = Nothing End Sub
ok so this is still a work in progress, but I've been working on pulling numbers automatically out my actions into the statements of rejection. updateNum() will update the numbering in hidden text at the begining of each section. if a 102 or 103 rejection statement is right above the marker, it will bold and insert the numbers in to that statement. You may have to go into options and make sure that hidden text is visible. the invisible flags STARTREJ and ENDREJ will border each section. To eliminate typos and anyother problems select an empty paragraph or a group of claims, and run surroundSelRej(). That will insert the markers.
Public Sub getNumbers() Call getNumbersR(Selection.Range) End Sub Public Sub updateNums() Dim p As Integer, start As Long, strList As String p = 1 Dim first As Boolean, firstStart As Long first = True Do While p <= ActiveDocument.Paragraphs.Count If ActiveDocument.Paragraphs.Item(p).Range.Font.Hidden = True Then If ActiveDocument.Range(ActiveDocument.Paragraphs.Item(p).Range.start, ActiveDocument.Paragraphs.Item(p).Range.start + Len(startFlag)) = startFlag Then start = ActiveDocument.Paragraphs.Item(p).Range.start If first Then firstStart = start first = False End If Do Until ActiveDocument.Paragraphs.Item(p).Range.Font.Hidden = True And ActiveDocument.Paragraphs.Item(p).Range.Text = endFlag & vbCr If p > ActiveDocument.Paragraphs.Count Then Exit Sub p = p + 1 Loop strList = strList & " " & getNumbersR(ActiveDocument.Range(start, ActiveDocument.Paragraphs.Item(p).Range.start)) End If End If p = p + 1: Loop Dim firstP As Paragraph p = 1 Do While p <= ActiveDocument.Paragraphs.Count If ActiveDocument.Paragraphs.Item(p).Range.Font.Hidden = True Then If ActiveDocument.Range(ActiveDocument.Paragraphs.Item(p).Range.start, ActiveDocument.Paragraphs.Item(p).Range.start + Len(startFlag)) = startFlag Then Set firstP = ActiveDocument.Paragraphs.Item(p) GoTo first End If End If p = p + 1: Loop Err.Raise vbError + 2, , "StartRej not found" Exit Sub first: If firstP.Previous.Range.Font.Hidden = True And firstP.Previous.Range.Text Like allFlag & "*" & vbCr Then firstP.Previous.Range.Text = allFlag & " " & formatNumbers(strList) & vbCr Else firstP.Range.InsertBefore (allFlag & " " & formatNumbers(strList) & vbCr) End If End Sub Public Function getNumbersR(r As Range) As String 'takes a selection Dim p As Paragraph Dim i As Integer Dim nums As String nums = "" On Error GoTo ErrorHandler ActiveDocument.ActiveWindow.View.ShowFirstLineOnly = False ' If Not Selection.Words(1) Like "Regarding " Then ' MsgBox "Error" ' Exit Sub ' End If ' For Each p In Selection.Paragraphs ' If p.Range.Words(1) Like "Regarding " Then ' i = 7 ' Do While (Asc(p.Range.Words(i).Characters(1)) >= Asc("0")) And (Asc(p.Range.Words(i).Characters(1)) <= Asc("9")) ' nums = nums & p.Range.Words(i).Text & " " ' i = i + 2 ' Loop ' End If ' Next p Dim reg As RegExp Dim mMatch As match Set reg = New RegExp reg.Global = True reg.MultiLine = True reg.IgnoreCase = True reg.Pattern = "^(\t)*Regarding (?:(?:in)?dependent )?claim(?:s|(?:\(s\)))? ((?:\d+[-\s,]*)+)( and [\d-]+)?," For Each mMatch In reg.Execute(r.Text) nums = nums & " " & mMatch.SubMatches(0) & mMatch.SubMatches(1) & mMatch.SubMatches(2) Next mMatch reg.Pattern = "Claim([s\s\?]*(?:[-,\*\d\s]|and)+\s*(?:is|are)*)\s*rejected" 'ActiveDocument.ActiveWindow.View.ShowFirstLineOnly = True 'ActiveWindow.ScrollIntoView r.Characters(1), True Dim list As New NumberList list.Create nums Dim strList As String strList = list.toString Dim matches As MatchCollection Dim fpPara As Word.Range Set fpPara = r.Paragraphs(1).Previous.Range If fpPara.Text Like allFlag & "*" & vbCr And fpPara.Font.Hidden = True Then Set fpPara = fpPara.Previous(WdUnits.wdParagraph) End If Set matches = reg.Execute(fpPara.Text) Dim one As Boolean reg.Pattern = "\D" one = Not reg.test(strList) If matches.Count = 1 Then 'add to fp fpPara.SetRange fpPara.start + InStr(fpPara.Text, matches(0).SubMatches(0)) - 1, fpPara.start + InStr(fpPara.Text, "rejected") - 1 fpPara.Text = IIf(one, " ", "s ") & strList & IIf(one, " is ", " are ") fpPara.Paragraphs(1).Range.Bold = True If ActiveDocument.Range(r.start, r.start + Len(startFlag)) = startFlag Then r.Paragraphs(1).Range.Text = startFlag & " " & strList & vbCr End If Else If ActiveDocument.Range(r.start, r.start + Len(startFlag)) = startFlag Then r.Paragraphs(1).Range.Text = startFlag & " " & strList & vbCr Else r.InsertParagraphBefore 'Selection.InsertBefore formatNumbers(nums) & " " r.InsertBefore strList & " " End If End If getNumbersR = strList Exit Function ErrorHandler: If Err.Number = 6028 Then fpPara.Fields(1).Delete Err.Clear Resume End If If Err.Number = 4605 Then Resume Next Else MsgBox Err.Description Resume End Function Public Sub surroundSelRej() Dim r As Range Set r = Selection.Range r.Paragraphs(1).Range.InsertBefore (startFlag & vbCr) r.InsertAfter (vbCr & vbCr) With r.Paragraphs(1).Range .Text = startFlag & vbCr .Font.Hidden = True End With With r.Paragraphs(r.Paragraphs.Count - 1).Range .Text = endFlag & vbCr .Font.Hidden = True End With End Sub Public Sub getNumbersRej() 'takes a selection Dim p As Paragraph Dim i As Integer Dim nums As String nums = "" On Error GoTo ErrorHandler ActiveDocument.ActiveWindow.View.ShowFirstLineOnly = False ' If Not Selection.Words(1) Like "Regarding " Then ' MsgBox "Error" ' Exit Sub ' End If ' For Each p In Selection.Paragraphs ' If p.Range.Words(1) Like "Regarding " Then ' i = 7 ' Do While (Asc(p.Range.Words(i).Characters(1)) >= Asc("0")) And (Asc(p.Range.Words(i).Characters(1)) <= Asc("9")) ' nums = nums & p.Range.Words(i).Text & " " ' i = i + 2 ' Loop ' End If ' Next p Dim reg As RegExp Dim mMatch As match Set reg = New RegExp reg.Global = True reg.MultiLine = True reg.IgnoreCase = False reg.Pattern = "Claim[s\s]*((?:[-,\d\s]|and)+)\s*(?:is|are)*\s*rejected" For Each mMatch In reg.Execute(Selection.Range.Text) nums = nums & " " & mMatch.SubMatches(0) Next mMatch ' Selection.InsertParagraphBefore ' Selection.InsertBefore formatNumbers(nums) & " " ' ActiveDocument.ActiveWindow.View.ShowFirstLineOnly = True ' ActiveWindow.ScrollIntoView Selection, True Dim r As VbMsgBoxResult Dim result As String result = formatNumbers(nums) r = MsgBox(result, vbOKCancel + vbQuestion, "Copy to Clipboard?") If r = vbOK Then Dim d As New MSForms.DataObject d.SetText result d.PutInClipboard End If Exit Sub ErrorHandler: If Err.Number = 4605 Then Resume Next Else MsgBox Err.Description Resume End Sub
Copy table rows from the IDS tab in edan (ctrl+s) and run this to paste in a list of IDS dates
Sub IDSfromEdan() Const dataPattern = "(\d{2}/){2}\d{4}(?=\t)" Dim reg As VBScript_RegExp_55.RegExp Dim matches As MatchCollection Dim data As DataObject Dim regI As Integer Dim strIDS As String Set reg = New RegExp Set data = New DataObject reg.Global = True reg.Pattern = dataPattern data.GetFromClipboard Set matches = reg.Execute(data.GetText) For regI = matches.Count - 2 To 0 Step -2 strIDS = strIDS & matches(regI) & ", " Next regI strIDS = Left(strIDS, IIf(Len(strIDS) < 2, 0, Len(strIDS) - 2)) If matches.Count > 1 Then strIDS = Left(strIDS, InStrRev(strIDS, ", ")) & Replace(strIDS, ", ", " and ", InStrRev(strIDS, ", ")) Selection = strIDS End SubNot sure how well this or the previous macro will work if your columns are setup differently then mine, but copy a whole row of a patent in the list of results in EAST and run this to paste in a nicely formatted patent number, name and date.
Const patentPattern = "[\s^](US (?:(\d{11})|(\d{7,8})) \w\d*)[\s$]" Const patenteePattern = "[\t^]([-\w]+)[,;](?:(?:[^\t]*?( et al\.))|(?:[^\t]*?[\t$]))" Const datePattern = "[\s^](\d{4})(\d\d)(\d\d)[\s$]" Dim reg As New VBScript_RegExp_55.RegExp 'Set reg = CreateObject("VBScript_RegExp_55.regexp") Dim results As MatchCollection Dim result As VBScript_RegExp_55.match Dim data As DataObject Dim east As String Dim patent As String Dim patentee As String Dim pubDate As String Set data = New DataObject On Error GoTo leave data.GetFromClipboard east = data.GetText reg.Pattern = patentPattern reg.Global = False Set result = reg.Execute(east).Item(0) 'patent = result.SubMatches(0) If result.SubMatches(1) = Empty Then 'patent patent = Format(result.SubMatches(2), "standard") patent = Left(patent, Len(patent) - 3) patent = Replace(result.SubMatches(0), result.SubMatches(2), patent) Else 'pgpub patent = Left(result.SubMatches(1), 4) & "/" & Mid(result.SubMatches(1), 5) patent = Replace(result.SubMatches(0), result.SubMatches(1), patent) End If reg.Pattern = patenteePattern reg.Global = False ' Set results = reg.Execute(east) ' If results.Count = 2 Then ' If results(0).Length < results(1).Length Then Set result = results(0) Else Set result = results(1) ' Else ' Set result = results.Item(0) ' ' End If Set result = reg.Execute(east).Item(0) patentee = result.SubMatches(0) & result.SubMatches(1) patent = Replace(patent, " ", Chr(160)) reg.Pattern = datePattern reg.Global = False Set result = reg.Execute(east).Item(0) pubDate = result.SubMatches(1) & "/" & result.SubMatches(2) & "/" & result.SubMatches(0) Selection = patentee & " (" & patent & ", " & pubDate & ")" Selection.MoveRight leave: End Sub
this will turn on all the buttons in oacs in the event they are all disabled for no reason, I don't think this will work the buttons in the ribbon, but the old command bar still exists on the Developer ribbon
Public Sub reenableOacsbuttons() Dim c As Object For Each c In FindCommandBar("OACS").Controls c.Enabled = True Next c End Sub
Put the right obviousness tatement in the rejection
Public Function isPreAIA() isPreAIA = InStr(ActiveDocument.Range.Text, "The present application is being examined under the pre-AIA first to invent provisions") > 0 End Function Public Function isAIA() isAIA = InStr(ActiveDocument.Range.Text, "The present application, filed on or after March 16, 2013, is being examined under the first inventor to file provisions of the AIA") > 0 End Function Public Sub ItWouldHave() Dim aia As Boolean, preaia As Boolean aia = isAIA preaia = isPreAIA Dim res As VbMsgBoxResult If (aia And preaia) Or (Not aia And Not preaia) Then res = MsgBox("Is case AIA?", vbYesNoCancel, "It would have...") If res = vbYes Then aia = True preaia = False ElseIf res = vbNo Then preaia = True aia = False ElseIf res = vbCancel Then Exit Sub Else Err.Raise vbError + 1, , "I can't program" End If End If Dim txt As String If aia Then txt = "It would have been obvious to one of ordinary skill in the art before the effective filing date of the claimed invention to" If preaia Then txt = "It would have been obvious to one of ordinary skill in the art at the time of the invention to" Selection.InsertAfter txt Selection.Collapse WdCollapseDirection.wdCollapseEnd End Sub
No comments:
Post a Comment