User:TJFrazier/Quotes

Check Curly Double Quotes

Features

• The macro checks sequences of double curly quotes. It allows multiple quoted areas per paragraph, and quotations continued in the next paragraph (no close-quote, but the next paragraph must start with an open-quote). Triply nested quotes will flag as errors, but the user can bypass these. (If this is a major nuisance for someone, let me know. Revisions are possible.)
• The macro can stop on any error, with the error character selected, for easy fixing; however, after the fix, the macro must be restarted. Therefore, I strongly recommend that the user should assign a keyboard shortcut, at least temporarily and at first. You may get a lot of errors initially, which means a lot of restarts.

Source

<source lang="oobas"> Sub QuoteChecker Dim bMoreText as Boolean Dim bQMS as Boolean 'Quote Must Start next para Dim iAnswer as Integer 'MsgBox reply Dim iClose as Long 'Found close-quote here Dim iOpen as Long Dim iWork as Long Dim jClose as Long 'Previous close-quote position Dim nErrs as Integer 'Counts Dim nPara as Integer Dim oDoc as Object Dim oTC as Object 'Text cursor Dim oViewCursor as Object Dim sPara as String 'Paragraph text Dim vEnum as Variant Dim vPara as Variant Const kLeft = &H201C 'Curly quotes Const kRight = &H201D

oDoc = ThisComponent vEnum = oDoc.Text.createEnumeration While vEnum.hasMoreElements

 vPara = vEnum.nextElement
 nPara = nPara + 1
 oTC = vPara.Text.createTextCursorByRange(vPara.Anchor)

 sPara = oTC.getString()
 iOpen = InStr( sPara, """" )
 While iOpen <> 0			'Found un-replaced straight quote, stop
   'These are easier to fix with GUI Find&Replace.
   nErrs = nErrs + 1
   call QuoteVC( oDoc, oTC, iOpen )	'set visual cursor to problem
   iAnswer = MsgBox( "Stop on straight quote?" _
     ,MB_YESNO + MB_ICONQUESTION, "Unreplaced Straight Quote" )
   If iAnswer = IDYES Then Exit Sub
   If iOpen = Len(sPara) Then	'at end of para
     iOpen = 0	'force exit
   Else
     iOpen = InStr( iOpen+1, sPara, """" )
   End If	'end of para
 Wend 'Straight quote(s) in paragraph
 
 iOpen = 0
 iClose = 0
 Do
   jClose = iClose
   iOpen = InStr( iOpen + 1, sPara, chr(kLeft) )
   iClose = InStr( iClose + 1, sPara, chr(kRight) )
   
   If bQMS and (iOpen <> 1) Then
     call QuoteVC( oDoc, oTC, 0 )
     nErrs = nErrs + 1
     iAnswer = MsgBox( _
       "Previous paragraph has an extra open quote." & chr(13) _
       & "This paragraph does not start with an open quote." & chr(13) _
       & "Stop here?" _
       , MB_YESNO + MB_ICONQUESTION, "Unbalanced Quotes" )
     If iAnswer = IDYES Then Exit Sub
   End If 'bQMS + iOpen
   bQMS = False

   If (0 < iOpen) and (iOpen < jClose) Then
     call QuoteVC( oDoc, oTC, iOpen )
     nErrs = nErrs + 1
     iAnswer = MsgBox( _
       "Two open quotes before close quote." & chr(13) _
       & "Stop here?" _
       , MB_YESNO + MB_ICONQUESTION, "Two Open Quotes Before Close" )
     If iAnswer = IDYES Then Exit Sub
   End If '0 < iOpen < jClose 
   

' I find it easier to think of four separate cases. YMMV.

   If (iOpen = 0) and (iClose = 0) Then
     Exit Do	'Done with paragraph
   ElseIf (iOpen > 0) and (iClose = 0) Then
     If InStr( iOpen + 1, SPara, chr(kLeft) ) = 0 Then	'one extra open is ok
       bQMS = True		'Quote must start next para
     Else		'more than one is /not/ ok
       call QuoteVC( oDoc, oTC, iOpen )
       nErrs = nErrs + 1
       iAnswer = MsgBox( "Multiple extra open quotes. Stop here?" _
         , MB_YESNO + MB_ICONQUESTION, "Multiple Unmatched Open Quotes" )
       If iAnswer = IDYES Then Exit Sub
     End If 'more open quotes
     Exit Do			'Done with this para, good or bad
   ElseIf (iOpen = 0) and (iClose > 0) Then
     call QuoteVC( oDoc, oTC, iClose )
     nErrs = nErrs + 1
     iAnswer = MsgBox( "Stop on unmatched close quote?" _
       , MB_YESNO + MB_ICONQUESTION, "Unmatched Close Quote" )
     If iAnswer = IDYES Then Exit Sub
     Exit Do
   Else		'Found both open and close quotes.
     If iOpen > iClose Then	'close before open? No.
       call QuoteVC( oDoc, oTC, iClose )
       nErrs = nErrs + 1
       iAnswer = MsgBox( "Stop on unmatched close quote?" _
         , MB_YESNO + MB_ICONQUESTION, "Close Quote Before Open" )
       If iAnswer = IDYES Then Exit Sub
       Exit Do
     End If 'close before open
   End If 'iOpen & iClose
 Loop While True	'Thru one paragraph

Wend 'For all paragraphs MsgBox "Paragraphs processed - " & str(nPara) & chr(13) _

 & "Total Errors - " & str(nErrs) _
 , MB_OK + MB_ICONINFORMATION, "QuoteChecker Results"

End Sub 'QuoteChecker

Sub QuoteVC(oDoc as Object, oTC as Object, iOffset as Long) 'Set visual cursor to targeted character(s). Dim oVis as Object oVis = oDoc.getCurrentController().getViewCursor() oVis.goToRange( oTC, False ) oVis.collapseToStart If iOffset > 1 Then oVis.goRight( iOffset - 1, False ) oVis.goRight( 1, True ) End Sub 'QuoteVC