If the journal can tell the difference between 0 point and 1 point next to em/en dashes, then this won't work. Otherwise, the following code finds all em and en dashes, then puts 1-point nonbreaking spaces on either side. Seems to work fine on my end.
I wasn't able to figure out how to get the font size from the found em/en dash, so you're prompted to provide it at the beginning of the macro. This is because the macro temporarily shrinks the em/en dashes to 1 point, along with the nonbreaking spaces, then returns just the dashes to their former size. I'm assuming that all instances of dashes will be the same size.
Code:
Sub StickyEmAndEnDashes() ' 03/28/2022
Dim oRange As Range
Dim strFontSize As String
Dim strDashtype() As String
Dim strReplaceString As String
Dim i As Long
' Prompt user for body text font size:
strFontSize = InputBox("Enter the body text font size:")
' Exit sub if user cancels:
If strFontSize = vbNullString Then
Exit Sub
End If
Set oRange = ActiveDocument.Range
' Populate an array with em- and en-dash wildcards:
strDashtype = Split("^+,^=", ",")
For i = LBound(strDashtype) To UBound(strDashtype)
' Concatenate a replace string variable, as it's not possible to
' mix strings and variables for the replacement string:
strReplaceString = "^s" & strDashtype(i) & "^s"
With oRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWildcards = True
' Find all em or en dashes:
.Text = strDashtype(i)
' Replace with nonbreak-em/en-dash-nonbreak, 1-pt font:
.Replacement.Text = strReplaceString
.Replacement.Font.Size = 1
.Execute Replace:=wdReplaceAll
' Find all em/en dashes again:
.Text = strDashtype(i)
.Replacement.Text = strDashtype(i)
' Replace with the normal font size:
.Replacement.Font.Size = strFontSize
.Execute Replace:=wdReplaceAll
End With
Next i
' Clean up:
With oRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWildcards = False
End With
Set oRange = Nothing
End Sub