SHARE
TWEET

Untitled

a guest Nov 22nd, 2018 110 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Function ZoterZeroFieldFix(F) ' Fix a field with ZoterZero
  2.     fieldChanged = 0 ' assume nothing changed, unless...
  3.     fieldText = F.Code.Text ' get the current code of the field as text
  4.     If InStr(fieldText, " ADDIN ZOTERO_ITEM CSL_CITATION") = 1 Then ' make sure this is a Zotero field to modify, starts with right text
  5.         myArray = Split(fieldText, " ", 5) ' split that code into parts up to 5
  6.         Dim Json As Object ' create a Json object to work with
  7.         Set Json = JsonConverter.ParseJson(myArray(4)) ' get the fourth part, which is the Json data
  8.         myResult = F.Result.Text ' get the displayed text from the field to work with it below
  9.         '' MAIN TEXT REPLACEMENT OF PAGE "0" WITH AUTHOR NAME ONLY
  10.         If Json("citationItems").Count = 1 Then ' only works for one citation item
  11.             If Json("citationItems")(1)("locator") = "0" Then ' if the page range is set to "0" process for ZoterZero:
  12.                If InStr(myResult, "(") = 1 Then ' if it begins with open parentheses...
  13.                     myResult = Split(myResult, "(", 2) ' split at parentheses, only 2 parts
  14.                     myResult = myResult(1) ' get the second part (without open parentheses)
  15.                     myResult = StrReverse(myResult) ' reverse the string so we can work from the other end:
  16.                     splitChar = " " ' default character to split is a space, occurring between name and year
  17.                     If InStr(myArray(4), """issued"":") = 0 Then ' if the year is missing, allow year-less name-only cites without parentheses:
  18.                         splitChar = ":" ' instead split at the colon because there is no year
  19.                     End If
  20.                     myResult = Split(myResult, splitChar, 2) ' split at splitChar, up to 2 parts
  21.                     myResult = myResult(1) ' get the second part (without the actually-last [=year] section)
  22.                     myResult = StrReverse(myResult) ' reverse back to normal order
  23.                     fieldChanged = 1 ' report updated below
  24.                 End If
  25.             '' ALTERNATIVE TEXT REPLACEMENT OF PAGE "00" WITH "AUTHOR (YYYY)" FORMAT, **ONLY FOR MOST COMMON SIMPLE SCENARIO**
  26.             ''' LIMITATION: ONLY WORKS WITHOUT PAGE NUMBERS DUE TO OBVIOUS CONFLICT WITH "00"...
  27.             ElseIf Json("citationItems")(1)("locator") = "00" Then ' if the page range is set to "0" process for ZoterZero:
  28.                If InStr(myResult, "(") = 1 AND InStr(myArray(4), """issued"":") Then ' if it begins with open parentheses and contains a date...
  29.                     myResult = Split(myResult, "(", 2) ' split at parentheses, only 2 parts
  30.                     myResult = myResult(1) ' get the second part (without open parentheses)
  31.                     myResult = StrReverse(myResult) ' reverse the string so we can work from the other end:
  32.                     splitChar = " " ' default character to split is a space, occurring between name and year
  33.                     myResult = Split(myResult, splitChar, 2) ' split at splitChar, up to 2 parts
  34.                     myResult = myResult(0) & "(" & splitChar & myResult(1) ' recombine with parentheses inserted
  35.                     myResult = Split(myResult, ":", 2) ' split without pages, up to 2 parts
  36.                     myResult = ")" & myResult(1) ' recombine without pages
  37.                     myResult = StrReverse(myResult) ' reverse back to normal order
  38.                     fieldChanged = 1 ' report updated below
  39.                 End If
  40.             End If
  41.         End If
  42.         '' SECONDARY TEXT REPLACEMENT FOR DOUBLED PARENTHESES TO REMOVE PARENTHESES
  43.         If Left(myResult, 2) = "((" Then ' if it begins with doubled open parentheses...
  44.             myResult = Split(myResult, "((", 2) ' split at double parentheses, only 2 parts
  45.             myResult = myResult(1) ' get the second part (without open double parentheses)
  46.             fieldChanged = 1 ' report updated below
  47.         End If
  48.         If Right(myResult, 2) = "))" Then ' if it ends with doubled open parentheses...
  49.             myResult = StrReverse(myResult) ' reverse the string so we can work from the end:
  50.             myResult = Split(myResult, "))", 2) ' split at double parentheses, only 2 parts
  51.             myResult = myResult(1) ' get the second part (without close double parentheses)
  52.             myResult = StrReverse(myResult) ' reverse the string back to normal:
  53.             fieldChanged = 1 ' report updated below
  54.         End If
  55.         '' UPDATE AND SAVE FIELD IF CHANGED ABOVE:
  56.         If fieldChanged = 1 Then ' the field text has been updated as MyResult, let's save it:
  57.             ' the following two lines make Zotero think this was the original output, so no warnings!
  58.             Json("properties")("plainCitation") = myResult ' set the Json citation data to new label
  59.             Json("properties")("formattedCitation") = myResult ' again, other instance
  60.             F.Result.Text = myResult ' replace the displayed text with the new text
  61.             F.Result.Font.Underline = wdUnderlineNone ' remove dashed underlining from Zotero's delayed update feature if present
  62.             myJson = JsonConverter.ConvertToJson(Json) ' collapse Json back to text
  63.             F.Code.Text = " " & myArray(1) & " " & myArray(2) & " " & myArray(3) & " " & myJson & " " ' reconstruct field code
  64.             ZoterZeroFieldFix = 1 ' updated, return success
  65.         End If
  66.     End If
  67. End Function
  68.  
  69. Sub ZoterZero()
  70. '
  71. ' ZoterZero main function
  72. '' if selection or text near cursor contains fields, check and fix them
  73. '' else check and fix all fields in document
  74. changeSuccess = 0 ' no fields fixed yet
  75. Selection.Expand Unit:=wdSentence ' expand the selection to at least sentence-level
  76. If Selection.Fields.Count > 0 Then ' if fields are selected...
  77.     checkField = Selection.Fields.Count ' get the total number of fields
  78.     While checkField > 0 ' check each field
  79.         changeSuccess = ZoterZeroFieldFix(Selection.Fields(checkField)) ' check and fix this field
  80.         checkField = checkField - 1 ' check the previous field next
  81.     Wend
  82. End If
  83. If changeSuccess = 0 Then ' no fields have been updated yet, let's update all fields in document
  84.         ' based on http://www.vbaexpress.com/kb/getarticle.php?kb_id=1100
  85.         Dim rngStory As Word.Range ' vars for below
  86.         Dim lngValidate As Long ' vars for below
  87.         Dim oShp As Shape ' vars for below
  88.         lngValidate = ActiveDocument.Sections(1).Headers(1).Range.StoryType ' starting point
  89.         For Each rngStory In ActiveDocument.StoryRanges 'Iterate through all linked stories
  90.           Do
  91.             On Error Resume Next
  92.             checkField = rngStory.Fields.Count ' get the total number of fields in this section
  93.             While checkField > 0 ' check each field
  94.                 changeSuccess = ZoterZeroFieldFix(rngStory.Fields(checkField)) ' check and fix this field
  95.                 checkField = checkField - 1 ' check the previous field next
  96.             Wend
  97.             Select Case rngStory.StoryType
  98.               Case 6, 7, 8, 9, 10, 11
  99.                 If rngStory.ShapeRange.Count > 0 Then
  100.                   For Each oShp In rngStory.ShapeRange
  101.                     If oShp.TextFrame.HasText Then
  102.                         checkField = Shp.TextFrame.TextRange.Fields.Count ' get the total number of fields in this section
  103.                         While checkField > 0 ' check each field
  104.                             changeSuccess = ZoterZeroFieldFix(Shp.TextFrame.TextRange.Fields(checkField)) ' check and fix this field
  105.                             checkField = checkField - 1 ' check the previous field next
  106.                         Wend
  107.                     End If
  108.                   Next
  109.                 End If
  110.               Case Else 'Do Nothing
  111.             End Select
  112.             On Error GoTo 0
  113.             'Get next linked story (if any)
  114.             Set rngStory = rngStory.NextStoryRange ' get ready for next section
  115.           Loop Until rngStory Is Nothing ' keep going through until all sections are done
  116.         Next
  117.     End If
  118.     Selection.Collapse ' reset cursor to beginning of section which isn't quite right but close enough
  119. End Sub
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Top