MS Word Macro - Infinite Spinning Wheel - Thanks Maxey!
Greg Maxey was kind enough to provide the last portion of code that I've since modified for the reasons stated below. Thanks Greg if you see this! So right now, I have this code for a VBA macro in the Normal>Module section of the VBA editor named "CntCntrls" that does the following:
-allows me to add rich text content control
-allows me to add a tag/title to the rich text content control -allows me to edit an existing tag/title to a rich text content control
-allows me to delete any rich text content control that does not have "Me" as the tag. This will also delete the page of the affected rich text content control so that there isn't excess space from the deleted rich text content controls
--
The problem I'm having is that I'm getting a spinning wheel that loads infinitely but never actually runs the macro despite the document being only 10 pages that I'm using for testing.
Is there something you guys can pick up on that may be potentially causing this issue?
--
Some potentially useful specs: -MacOs Monterey 12.6.8 on 2021 M1 Macbook pro -Office Home & Business 2021 License
--
Sub A_A_AddRichTextControl()
Dim rngSelection As Range
Set rngSelection = Selection.Range
ActiveDocument.ContentControls.Add Type:=wdContentControlRichText, Range:=rngSelection
End Sub
Sub A_B_EditTagAndTitleOfRichTextControl()
Dim cc As ContentControl
Dim newTag As String
If Selection.Range.ContentControls.Count = 1 Then
Set cc = Selection.Range.ContentControls(1)
' Prompt for new tag
newTag = InputBox("Enter new tag for the rich text content control:", "New Tag")
' Set new tag and title
If newTag <> "" Then
cc.tag = newTag
cc.Title = newTag ' Set title equal to the tag
End If
Else
MsgBox "Select a single rich text content control to edit tag and title.", vbExclamation
End If
End Sub
Sub A_C_EditContentControlTagAndTitle()
Dim cc As ContentControl
Dim newTag As String
' Check if the selection contains a content control
If Selection.Range.ContentControls.Count > 0 Then
' Store a reference to the first content control in the selection
Set cc = Selection.Range.ContentControls(1)
' Prompt the user for new tag and title values
newTag = InputBox("Enter the content control property tag:", "Edit Tag", cc.tag)
' Update the tag and title
cc.tag = newTag
cc.Title = newTag
' Optional: Refresh the content control to apply changes
cc.LockContentControl = True
cc.LockContentControl = False
Else
MsgBox "Please select a content control before running this macro.", vbExclamation
End If
End Sub
Sub B_A_RemoveRT_ExceptMe()
Dim oCC As ContentControl
Dim arrTagParts() As String
Dim lngIndex As Long
Dim bDelete As Boolean
Dim oPage As Range
For Each oCC In ActiveDocument.ContentControls
bDelete = True
If oCC.Type = 0 Then 'wdContentControlText
arrTagParts = Split(oCC.tag, " ")
For lngIndex = 0 To UBound(arrTagParts)
If arrTagParts(lngIndex) = "Me" Then
bDelete = False
Exit For
End If
Next lngIndex
If bDelete Then
' Get the page range of the content control
Set oPage = oCC.Range.GoTo(wdGoToPage, wdGoToAbsolute, oCC.Range.Information(wdActiveEndPageNumber))
' Delete the content control
oCC.Delete True
' Delete the entire page
oPage.Delete
End If
End If
Next oCC
lbl_Exit:
Exit Sub
End Sub
|