Word VBA Macro create calendars for boox pdf

 Sub CreateMonthlyCalendar_Landscape()

  Dim yearInput As Integer

    Dim monthIndex As Integer

    Dim mName As String

    Dim firstDate As Date

    Dim lastDate As Date

    Dim tableRows As Integer, tableCols As Integer

    Dim doc As Document

    Dim calTable As Table

    Dim r As Integer, c As Integer

    Dim currentDate As Date

    Dim weekendsColor As Long

    Dim firstWeekday As Integer

    Dim totalDays As Integer

    Dim totalSlots As Integer

    Dim numWeeks As Integer

    

    ' === SETTINGS ===

    weekendsColor = RGB(220, 230, 241)  ' Light blue weekend shading

    tableCols = 7

    

    ' === ASK FOR YEAR ===

    yearInput = InputBox("Enter the calendar year (e.g., 2025):", "Calendar Year", year(Date))

    If Not IsNumeric(yearInput) Then Exit Sub

    If yearInput < 1900 Or yearInput > 2100 Then

        MsgBox "Please enter a valid year between 1900 and 2100."

        Exit Sub

    End If

    

    Set doc = Documents.Add

    With doc.PageSetup

        .Orientation = wdOrientLandscape

        .TopMargin = CentimetersToPoints(0.8)

        .BottomMargin = CentimetersToPoints(0.8)

        .LeftMargin = CentimetersToPoints(0.8)

        .RightMargin = CentimetersToPoints(0.8)

    End With

    

    ' === LOOP THROUGH EACH MONTH ===

    For monthIndex = 1 To 12

        mName = monthName(monthIndex)

        firstDate = DateSerial(yearInput, monthIndex, 1)

        lastDate = DateSerial(yearInput, monthIndex + 1, 0)

        

        ' Page break between months

        If monthIndex > 1 Then doc.Range(doc.Content.End - 1).InsertBreak Type:=wdPageBreak

        

        ' Month heading

        doc.Range.InsertAfter vbCr

        With doc.Paragraphs.Last.Range

            .Text = mName & " " & yearInput

            .Style = "Heading 1"

            .ParagraphFormat.Alignment = wdAlignParagraphCenter

            .InsertParagraphAfter

        End With

        

        ' Determine number of rows needed

        firstWeekday = Weekday(firstDate, vbMonday)

        totalDays = Day(lastDate)

        totalSlots = (firstWeekday - 1) + totalDays

        numWeeks = (totalSlots + 6) \ 7

        tableRows = numWeeks + 1  ' +1 for header row

        

        ' Insert table

        Set calTable = doc.Tables.Add(Range:=doc.Paragraphs.Last.Range, NumRows:=tableRows, NumColumns:=tableCols)

        calTable.Borders.Enable = True

        calTable.PreferredWidthType = wdPreferredWidthPercent

        calTable.PreferredWidth = 100

        

        ' Header row (Mon–Sun)

        Dim daysOfWeek As Variant

        daysOfWeek = Array("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun")

        For c = 1 To tableCols

            With calTable.Cell(1, c).Range

                .Text = daysOfWeek(c - 1)

                .ParagraphFormat.Alignment = wdAlignParagraphCenter

                .Bold = True

            End With

        Next c

        

        ' Fill in dates

        currentDate = firstDate

        r = 2

        c = firstWeekday

        

        Do While currentDate <= lastDate

            With calTable.Cell(r, c).Range

                .Text = Day(currentDate)

                .ParagraphFormat.Alignment = wdAlignParagraphRight

            End With

            

            ' Shade weekends

            If Weekday(currentDate, vbMonday) > 5 Then

                calTable.Cell(r, c).Shading.BackgroundPatternColor = weekendsColor

            End If

            

            currentDate = currentDate + 1

            c = c + 1

            If c > 7 Then

                c = 1

                r = r + 1

            End If

        Loop

        

        ' === Adjust table appearance ===

        On Error Resume Next

        calTable.Rows.HeightRule = wdRowHeightExactly

        

        ' Smaller header row

        calTable.Rows(1).Height = CentimetersToPoints(0.9)

        

        ' Slightly smaller date rows

        For r = 2 To calTable.Rows.Count

            calTable.Rows(r).Height = CentimetersToPoints(2.4)

        Next r

        

        ' Column width for landscape fit

        calTable.Columns.PreferredWidth = CentimetersToPoints(3.7)

        On Error GoTo 0

        

        ' Reduce spacing around the table

        calTable.Rows.SpaceBetweenColumns = 0

        calTable.Range.ParagraphFormat.SpaceBefore = 0

        calTable.Range.ParagraphFormat.SpaceAfter = 3

    Next monthIndex

    

    MsgBox "Compact landscape calendar created for " & yearInput & "!", vbInformation

End Sub

Sub AKCreateMonthlyCalendar()

 

    Dim yearInput As Integer

    Dim monthIndex As Integer

    Dim mName As String

    Dim firstDate As Date

    Dim lastDate As Date

    Dim dayNum As Integer

    Dim weekdayNum As Integer

    Dim tableRows As Integer

    Dim tableCols As Integer

    Dim doc As Document

    Dim calTable As Table

    Dim r As Integer, c As Integer

    Dim currentDate As Date

    Dim cellText As String

    Dim weekendsColor As Long

    Dim firstWeekday As Integer

    Dim totalDays As Integer

    Dim totalSlots As Integer

    Dim numWeeks As Integer

    

    ' === SETTINGS ===

    weekendsColor = RGB(220, 230, 241)  ' Light blue highlight for weekends

    tableCols = 7

    

    ' === ASK FOR YEAR ===

    yearInput = InputBox("Enter the calendar year (e.g., 2025):", "Calendar Year", year(Date))

    If Not IsNumeric(yearInput) Then

        MsgBox "Please enter a valid year."

        Exit Sub

    End If

    If yearInput < 1900 Or yearInput > 2100 Then

        MsgBox "Please enter a valid year between 1900 and 2100."

        Exit Sub

    End If

    

    Set doc = Documents.Add

    doc.PageSetup.Orientation = wdOrientPortrait

    

    ' === LOOP THROUGH EACH MONTH ===

    For monthIndex = 1 To 12

        mName = monthName(monthIndex)           ' use a different variable name so MonthName() isn't shadowed

        firstDate = DateSerial(yearInput, monthIndex, 1)

        lastDate = DateSerial(yearInput, monthIndex + 1, 0)

        

        ' Add a page break between months (except first)

        If monthIndex > 1 Then

            doc.Range(doc.Content.End - 1).InsertBreak Type:=wdPageBreak

        End If

        

        ' Insert month heading

        doc.Range.InsertAfter vbCr

        With doc.Paragraphs.Last.Range

            .Text = mName & " " & yearInput

            .Style = "Heading 1"

            .ParagraphFormat.Alignment = wdAlignParagraphCenter

            .InsertParagraphAfter

        End With

        

        ' Calculate number of rows needed for date grid

        firstWeekday = Weekday(firstDate, vbMonday)   ' 1 = Monday ... 7 = Sunday

        totalDays = Day(lastDate)

        totalSlots = (firstWeekday - 1) + totalDays

        numWeeks = (totalSlots + 6) \ 7               ' integer division rounding up

        tableRows = numWeeks + 1                      ' +1 for header row

        

        ' Insert table (header row + weeks rows)

        Set calTable = doc.Tables.Add(Range:=doc.Paragraphs.Last.Range, NumRows:=tableRows, NumColumns:=tableCols)

        calTable.Borders.Enable = True

        calTable.PreferredWidthType = wdPreferredWidthPercent

        calTable.PreferredWidth = 100

        

        ' Header row (Mon–Sun)

        Dim daysOfWeek As Variant

        daysOfWeek = Array("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun")

        For c = 1 To tableCols

            With calTable.Cell(1, c).Range

                .Text = daysOfWeek(c - 1)

                .ParagraphFormat.Alignment = wdAlignParagraphCenter

                .Bold = True

            End With

        Next c

        

        ' Fill in dates

        currentDate = firstDate

        r = 2

        c = firstWeekday

        

        Do While currentDate <= lastDate

            cellText = CStr(Day(currentDate))

            With calTable.Cell(r, c).Range

                .Text = cellText

                .ParagraphFormat.Alignment = wdAlignParagraphRight

                .ParagraphFormat.SpaceAfter = 6

            End With

            

            ' Highlight weekends (Saturday=6, Sunday=7 when Weekday(..., vbMonday))

            If Weekday(currentDate, vbMonday) > 5 Then

                calTable.Cell(r, c).Shading.BackgroundPatternColor = weekendsColor

            End If

            

            ' Advance to next day

            currentDate = currentDate + 1

            c = c + 1

            If c > 7 Then

                c = 1

                r = r + 1

            End If

        Loop

        

        ' Optional: make cells a reasonable size for notes

        On Error Resume Next

        calTable.Rows.HeightRule = wdRowHeightExactly

        calTable.Rows.Height = CentimetersToPoints(2.6)  ' adjust as desired

        calTable.Columns.PreferredWidth = CentimetersToPoints(2.5)

        On Error GoTo 0

        

        calTable.Range.ParagraphFormat.SpaceBefore = 3

        calTable.Range.ParagraphFormat.SpaceAfter = 3

    Next monthIndex

    

    MsgBox "Calendar created for " & yearInput & "!", vbInformation

End Sub

Sub AKCreateGoalStatement word vba

 Sub AKCreateGoalStatement()

    Dim goal As String

    Dim month As String

    Dim year As String

    Dim emotion As String

    

        monthAndYear = InputBox("Enter the goal month and year(e.g., November 2025):")

    goal = InputBox("Enter the goal (how to know it's achieved):")

    emotion = InputBox("Enter the emotion you'll feel when achieved:")

    

    

    Dim statement As String

    statement = "It is now " & monthAndYear & " and " & goal & " and " & emotion & "."

    

    Selection.TypeText Text:=statement & vbCrLf

End Sub

Microsoft word VBA functions 2025

 

Sub AKDeleteEmptyRows_AllTables()

 

Dim oTable As Table

Dim oRow As Row

Dim intRowCount As Integer

 

For Each oTable In ActiveDocument.Tables

  

    'Check whether row is empty - delete if it is

    'ATK 1/6/2024  what does * 2 + 2 mean??????

   

       'first fo any nested tables

    For Each nestedTable In oTable.Tables

       intRowCount = nestedTable.Rows.Count

        For Each nestedRow In nestedTable.Rows

            If Len(nestedRow.Range.Text) = nestedRow.Cells.Count * 2 + 2 Then

                nestedRow.Delete

            End If

        Next nestedRow

    Next nestedTable

        For Each oRow In oTable.Rows

            oRow.Select

         intRowCount = oTable.Rows.Count

         oRow.Select

        If Len(oRow.Range.Text) = oRow.Cells.Count * 2 + 2 Then

           oRow.Delete

        End If

   

    Next oRow

Next oTable

 

 

 

 

Exit Sub

 

End Sub 'AKDeleteEmptyRows_AllTables()

Sub AKRemoveSpacesAndLines()

'

' AKRemoveSpacesAndLines Macro

'

'

    Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    With Selection.Find

        .Text = "2024-??-*:??:??"

        .Replacement.Text = " "

        .Forward = True

        .Wrap = wdFindContinue

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    With Selection.Find

        .Text = "2024-??-*:??:??"

        .Replacement.Text = " "

        .Forward = True

        .Wrap = wdFindContinue

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchAllWordForms = False

        .MatchSoundsLike = False

        .MatchWildcards = True

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    Selection.Copy

    Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    With Selection.Find

        .Text = "________________________________________"

        .Replacement.Text = " "

        .Forward = True

        .Wrap = wdFindContinue

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchAllWordForms = False

        .MatchSoundsLike = False

        .MatchWildcards = True

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    With Selection.Find

        .Text = "^p^p"

        .Replacement.Text = "~!@#"

        .Forward = True

        .Wrap = wdFindContinue

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    Selection.Find.Execute Replace:=wdReplaceAll

    ActiveWindow.ActivePane.View.ShowAll = Not ActiveWindow.ActivePane.View. _

        ShowAll

    Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    With Selection.Find

        .Text = "^p ^p"

        .Replacement.Text = "~!@#"

        .Forward = True

        .Wrap = wdFindContinue

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    Selection.Find.Execute Replace:=wdReplaceAll

    With Selection.Find

        .Text = "^p"

        .Replacement.Text = " "

        .Forward = True

        .Wrap = wdFindContinue

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    With Selection.Find

        .Text = "~!@#"

        .Replacement.Text = "^p^p"

        .Forward = True

        .Wrap = wdFindContinue

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

End Sub

Sub AKMakeTrueTitleCaseHeading1s()

' AKMakeTrueTitleCaseHeading1- Ones -

    ' was called Sub Heading1MakeTitle()

' Calls TitleCase procedure

' Paul Edstein

' http://www.msofficeforums.com/word/24807-how-do-i-convert-line-text-title.html#post78192

' Makes all Heading 1 text title case ' I think I have to select all text....

'

    Application.ScreenUpdating = False

    Dim StrTmp As String

    With ActiveDocument.Range

      With .Find

        Let .MatchWildcards = True

        .ClearFormatting

        .Replacement.ClearFormatting

        Let .Format = True

        Let .Wrap = wdFindStop

        .Execute Replace:=wdReplaceAll

        Let .Style = "Heading 1"

        Let .Text = "[!^13]{1,}"

        Let .Replacement.Text = ""

        .Execute

      End With

      Do While .Find.Found

        StrTmp = Trim(.Text)

        While Right(StrTmp, 1) = "."

          Let StrTmp = Left(StrTmp, Len(StrTmp) - 1)

        Wend

        While InStr(StrTmp, "  ") > 0

          Let StrTmp = Replace(StrTmp, "  ", " ")

        Wend

        StrTmp = TitleCase(StrTmp, bCaps:=False, blExcludeCertainWords:=True)

        Let .Text = StrTmp

        .Collapse wdCollapseEnd

        .Find.Execute

      Loop

    End With

    Application.ScreenUpdating = True

'

'

End Sub ' AK make all headings 1s true title case

Sub MakeTitle()

' Calls TitleCase procedure

' Paul Edstein

' http://www.msofficeforums.com/word/24807-how-do-i-convert-line-text-title.html#post78192

' Converts selected text to true Title Case

'

    Application.ScreenUpdating = False

    Dim StrTmp As String

    With Selection.Range

      Let StrTmp = Trim(.Text)

      While Right(StrTmp, 1) = "."

        Let StrTmp = Left(StrTmp, Len(StrTmp) - 1)

      Wend

      While InStr(StrTmp, "  ") > 0

        Let StrTmp = Replace(StrTmp, "  ", " ")

      Wend

      Let StrTmp = TitleCase(StrTmp, bCaps:=False, blExcludeCertainWords:=True)

      .Text = StrTmp

    End With

    Let Application.ScreenUpdating = True

End Sub

Private Function TitleCase(StrTxt As String, Optional bCaps As Boolean, Optional bClos As Boolean, Optional blExcludeCertainWords As Boolean) As String

' Paul Edstein

' http://www.msofficeforums.com/word/24807-how-do-i-convert-line-text-title.html#post78192

' December 2016

' Goes with MakeTitle and HeadingMakeTitle macros

' Added Let to beginning of variable definitions CKK 2018-10-07

'

'Convert an input string to proper-case.

'Surnames like O', Mc & Mac and hyphenated names are converted to title case also.

'If bCaps = True, then upper-case strings like ABC are preserved; otherwise they're converted.

'If bClos = False, words in the exclusion list after closing characters are retained as lower-case; otherwise they're converted.

'If blExcludeCertainWords = True, words in the exclusion list are retained as lower-case, unless after specified punctuation marks.

    Dim i As Long, j As Long, k As Long, l As Long, bFnd As Boolean

    Dim StrChr As String, StrExcl As String, StrMac As String, StrPunct As String, StrTmpA As String, StrTmpB As String

    'General exclusion list.

    Let StrExcl = "(a),a,am,an,and,are,as,at,(b),be,but,by,(c),can,cm,(d),did,do,does,(e),eg,en,eq,etc,(f),for," & _

              "(g),get,go,got,(h),has,have,he,her,him,how,(i),ie,if,in,into,is,it,its,(j),(k),(l),(m),me,mi," & _

              "mm,my,(n),na,nb,no,not,(o),of,off,ok,on,one,or,our,out,(p),(q),(r),re,(s),she,so,(t),the," & _

              "their,them,they,this,to,(u),(v),via,vs,(w),was,we,were,who,will,with,would,(x),(y),yd,you,your,(z)"

    'Mac name lower-case list.

    Let StrMac = "Macad,Macau,Macaq,Macaro,Macass,Macaw,Maccabee,Macedon,Macerate,Mach,Mack,Macle,Macrame,Macro,Macul,Macumb"

    Let StrPunct = "!,;,:,.,?,/,(,{,[,<,“,"""

    If bClos = True Then StrPunct = StrPunct & ",),},],>,”"

    If blExcludeCertainWords = False Then

      Let StrExcl = ""

      Let StrPunct = ""

    Else

      Let StrExcl = " " & Replace(Trim(StrExcl), ",", " , ") & " "

    End If

    If Len(Trim(StrTxt)) = 0 Then

      Let TitleCase = StrTxt

      Exit Function

    End If

    If bCaps = False Then StrTxt = LCase(StrTxt)

    StrTxt = " " & StrTxt & " "

    For i = 1 To UBound(Split(StrTxt, " ")) - 1

      Let StrTmpA = Split(StrTxt, " ")(i)

      'Check for a double-quote before the word

      If Left(StrTmpA, 1) Like "[""“”]" Then

        Let StrTmpB = UCase(Left(StrTmpA, 2)) & Right(StrTmpA, Len(StrTmpA) - 2)

      Else

        Let StrTmpB = UCase(Left(StrTmpA, 1)) & Right(StrTmpA, Len(StrTmpA) - 1)

      End If

      Let StrTmpB = " " & StrTmpB & " "

      Let StrTmpA = " " & StrTmpA & " "

      Let StrTxt = Replace(StrTxt, StrTmpA, StrTmpB)

    Next

    'Code for handling hyphenated words

    For i = 1 To UBound(Split(StrTxt, "-"))

      Let StrTmpA = Split(StrTxt, "-")(i)

      Let StrTmpB = UCase(Left(StrTmpA, 1)) & Right(StrTmpA, Len(StrTmpA) - 1)

      Let StrTxt = Replace(StrTxt, StrTmpA, StrTmpB)

    Next

    'Code for handling family names starting with O'

    For i = 1 To UBound(Split(StrTxt, "'"))

      If InStr(Right(Split(StrTxt, "'")(i - 1), 2), " ") = 1 Or _

        Right(Split(StrTxt, "'")(i - 1), 2) = Right(Split(StrTxt, "'")(i - 1), 1) Then

        Let StrTmpA = Split(StrTxt, "'")(i)

        Let StrTmpB = UCase(Left(StrTmpA, 1)) & Right(StrTmpA, Len(StrTmpA) - 1)

        Let StrTxt = Replace(StrTxt, StrTmpA, StrTmpB)

      End If

    Next

    'Code for handling family names starting with Mc

    If Left(StrTxt, 2) = "Mc" Then

      Let Mid(StrTxt, 3, 1) = UCase(Mid(StrTxt, 3, 1))

    End If

    Let i = InStr(StrTxt, " Mc") + InStr(StrTxt, """Mc")

    If i > 0 Then

      Let Mid(StrTxt, i + 3, 1) = UCase(Mid(StrTxt, i + 3, 1))

    End If

    'Code for handling family names starting with Mac

    If InStr(1, StrTxt, "Mac", vbBinaryCompare) > 0 Then

      For i = 1 To UBound(Split(StrTxt, " "))

        Let StrTmpA = Split(StrTxt, " ")(i)

        If InStr(1, StrTmpA, "Mac", vbBinaryCompare) > 0 Then

          Let StrTmpA = Left(StrTmpA, Len(StrTmpA) - InStr(1, StrTmpA, "Mac", vbBinaryCompare) + 1)

          Let bFnd = False

          For j = 0 To UBound(Split(StrMac, ","))

            Let StrTmpB = Split(StrMac, ",")(j)

            If Left(StrTmpA, Len(StrTmpB)) = StrTmpB Then

              Let bFnd = True

              Exit For

            End If

          Next

          If bFnd = False Then

            If Len(Split(Trim(StrTmpA), " ")(0)) > 4 Then

              Let StrTmpB = StrTmpA

              Let Mid(StrTmpB, 4, 1) = UCase(Mid(StrTmpB, 4, 1))

              Let StrTxt = Replace(StrTxt, StrTmpA, StrTmpB)

            End If

          End If

        End If

      Next

    End If

    'Code to restore excluded words to lower case

    If StrExcl <> "" Then

      For i = 0 To UBound(Split(StrExcl, ","))

        Let StrTmpA = Split(StrExcl, ",")(i)

        Let StrTmpB = UCase(Left(StrTmpA, 2)) & Right(StrTmpA, Len(StrTmpA) - 2)

        If InStr(StrTxt, StrTmpB) > 0 Then

          Let StrTxt = Replace(StrTxt, StrTmpB, StrTmpA)

          'Make sure an excluded words following punctution marks are given proper case anyway

          For j = 0 To UBound(Split(StrPunct, ","))

            Let StrChr = Split(StrPunct, ",")(j)

            Let StrTxt = Replace(StrTxt, StrChr & StrTmpA, StrChr & StrTmpB)

          Next

        End If

      Next

    End If

    Let TitleCase = Trim(StrTxt)

End Function ' TitleCase

'

Sub ConvertURLsToHyperlinks()

    Dim rng As Range

    Dim i As Long

    Dim urlPattern As String

    Dim urlMatch As Object

    Dim url As String

    Dim para As Paragraph

    

 

    ' Regular expression pattern to match URLs

    urlPattern = "(http|https)://[a-zA-Z0-9./?=_-]+"

 

    ' Loop through each paragraph in the document

    For Each para In ActiveDocument.Paragraphs

        Set rng = para.Range

        Set urlMatch = Nothing

         

        ' Use Regular Expressions to find URLs

        With CreateObject("VBScript.RegExp")

            .Pattern = urlPattern

            .Global = True

            If .Test(rng.Text) Then

                Set urlMatch = .Execute(rng.Text)

                ' Loop through all matches

                For i = 0 To urlMatch.Count - 1

                    url = urlMatch(i).Value

                    rng.Hyperlinks.Add Anchor:=rng, Address:=url, TextToDisplay:=url

                Next i

            End If

        End With

    Next para

End Sub ' createallhyperlinks

Publish or perish - research software literature software

 For those in academia or research - Publish or Perish software is excellent if you really want to find popular research papers on a subject. Highly recommended. https://harzing.com/resources/publish-or-perish

Google Docs and Sheets AppScript to add menu and replace new lines

 

function onOpen() {

  const ui = DocumentApp.getUi();

  const menu = ui.createMenu('AK Menu'); // Replace 'My Menu' with your desired menu name

  menu.addItem('AKReplace', 'replaceAKNewlinesAndCaptureExpressions'); // Replace 'Show Spreadsheet Name' and 'showName' with your desired item name and function name

  menu.addToUi();

}

function replaceAKNewlinesAndCaptureExpressions() {

  // allows google docs to use matching capture in replace expression

  // eg (\d\d )\n - find things like 10 \n - newline

  // replace with $1  - removes the new line character and keeps the digits eg 11

  var body = DocumentApp.getActiveDocument().getBody();

  var paragraphs = body.getParagraphs();

   const ui = DocumentApp.getUi();

    const response = ui.prompt(

    'Search Text? (currently HARDCODED)',

    ui.ButtonSet.YES_NO,);

  for (var i=0; i<paragraphs.length; i++) {

    var text = paragraphs[i].getText();

    // need to create an input form here or two or three popups for search text

    // replace text

    paragraphs[i].replaceText("(\d\d) \n", "$1") ;

  }

}