用VBA检查Word文档中是否存在位于行首的脚注引用，如存在则通过调整字符间距使其移动到非行首的位置

在Word文档中插入脚注时，有时候会出现脚注引用序号出现在行首的情况，这样阅读的时候总觉得不便，而且按中文排版习惯，这种引用符号也不应该出现在行首。如下图所示：

上图中脚注3和6的位置就不好，4和5位置则正常。按中文排版习惯，脚注引用应该显示到一行的中间或者末尾。上图中要做调整很简单，选择脚注引用之前的若干文字，通过开始面板上的字体工具组右下角小箭头打开字体对话框，调整字符间距即可，如下图所示：

但是，如果文档中有很多脚注引用，人工一处一处检查是否存在位于行首的脚注引用，找到后再调整就实在痛苦了。如果不想崩溃，使用VBA几乎是必然甚至唯一的选择。代码如下，有详尽注释：

Sub 将文档中所有在行首的脚注引用压缩到上一行()
    Dim moveLines As Integer, endPos as Long, spacing As Double
    ' 变量spacing记录调整字符间距时的紧缩量，如果字体大于四号，也许需要加大紧缩量
    spacing = -0.3
    ' 变量endPos记录文档结束位置。由于本代码未做插入操作，文档结束位置不会变动，
    ' 无需实时获取文档结束位置，用变量记录结束位置的值在循环中读取时可提高效率
	endPos =  ActiveDocument.Content.End - 1
    ' 移动光标前关闭屏幕滚动，提高代码执行效率。也可以在宏开始时就关闭屏幕滚动。
    Application.ScreenUpdating = False
    ' 接下来有大量光标操作，用With块可以提高效率，并缩短代码长度。
    With Selection
    	' 光标移动到文档开头。HomeKey方法移动到开头，具体移动到段落、文档还是行等，由参数unit指定
    	.HomeKey unit:=wdStory
    	' 逐行循环检查行首是否有脚注引用
	    Do
	        ' 为防止出现死循环，将光标移至行尾，以便与文档结束位置比较。Extend:=wdMove是默认值，可省略。
	        ' EndKey方法移动到结尾，具体移动到段落、文档还是行等，由参数unit指定
	        .EndKey unit:=wdLine, Extend:=wdMove
	        	       
	        ' 将选区扩展至行首。光标实际上是由start和end两个位置指示器合并的。Extend参数指定start和end
	        ' 两个位置指示器是绑定在一起移动还是单独移动。单独移动就产生了选择效果。
	        ' Extend参数的默认值为wdMove，start和end指示器绑定在一起移动，wdExtend则单独移动。
	        ' 手机上长按文字后稍微移动，可以更直观地看到光标分成start和end两个位置指示器。
	        .HomeKey unit:=wdLine, Extend:=wdExtend
	        ' 若选区第一个字符的样式为“脚注引用”
	        If .Characters(1).Style = "脚注引用" Then
	            ' 则将选区向上扩展一行，字符间距压缩适当磅数
	            .MoveUp unit:=wdLine, Count:=1, Extend:=wdExtend
	            .Font.Spacing = spacing
	        End If	

			' 光标所在位置已经到达文档内容结束位置，则已处理完毕，终止循环
	        If .End = endPos Then
	            Exit Do
	        End If
	        
	         ' 光标移动到下一行。count:=1是默认值，可省略。下一行代码与.MoveDown等价。
	        ' Move方法返回移动数量。由于循环结束前比较了光标是否到达文档内容结束位置,Move方法的返回值实际上没有用。
	        moveLines = .Move(unit:=wdLine, Count:=1)
	        
	        ' 如果移动到了脚注或尾注区域，由于它们段首的脚注引用应该在行首，不应进行调整，
	        ' 所以一直向下移动，直至移出相关区域。可以用.Information方法判断光标是否在脚注或尾注中
	        Do While .Information(wdInFootnote) Or .Information(wdInEndnote)
	                moveLines = Selection.MoveDown(unit:=wdLine, Count:=1)
	                ' 判断是否成功移动，不成功则在最后一条脚注或尾注中
	                ' 实际上，由于此代码采用了比较光标位置与文档内容结束位置来判断是否处理完毕，
	                ' 光标不可能移动到最后一页中的脚注（最后一页中的脚注会在内容结束之后），所以下面这个判断其实可以删除。实际上在测试中光标没有进入过脚注区域，也就是说这个内部do循环似乎可以删除，不过因为测试可能覆盖不全，稳妥起见还是保留。
	                ' If moveLines < 1 Then
	                '    Exit Do
	                ' End If
	        Loop        
	    Loop
	 End With
    '恢复屏幕滚动
    Application.ScreenUpdating = True
    MsgBox "Done!"
End Sub

下面是删除多余代码和注释后较为清爽的宏代码，其实代码量不多啊^-^！此代码在Word2007和Word2021上测试通过，经历了空文档、只有一行的文档、没有脚注的文档、多页有脚注和没有脚注文档、最后一页有脚注和没有脚注的文档等多种文档考验。

Sub 将文档中所有在行首的脚注引用移动到非行首位置()
    Dim spacingTimes, EOC as Long
    spacingTimes = 0 ' 字符间距调整次数
    EOC  =  ActiveDocument.Content.End - 1
    Application.ScreenUpdating = False
    With Selection
        .HomeKey unit:=wdStory
        Do
            .EndKey unit:=wdLine
            .HomeKey unit:=wdLine, Extend:=wdExtend
            If Not .Characters(1).Style Is Nothing Then
                If .Characters(1).Style = "脚注引用" Then
                    .MoveUp
                    .EndKey unit:=wdLine, Extend:=wdExtend
                    ' 上一行文字字符间距每次加宽0.1，反复执行这个宏，直至提示间距调整次数为0
                    .Font.spacing = .Font.spacing + 0.1
                    spacingTimes = spacingTimes + 1
                End If
            End If
            If .End = EOC Then
	            Exit Do
	        End If
            .MoveDown
            Do While .Information(wdInFootnote) Or .Information(wdInEndnote)
                If .MoveDown < 1 Then
                    GoTo done
                End If
            Loop
        Loop
    End With
    Application.ScreenUpdating = True
done:
    MsgBox "一次检查完成。如间距调整次数不为0，请再次执行。" & _
    	vbCrLf & "本次检查间距调整次数为：" & spacingTimes 
End Sub

下面是上述代码运行后的效果：

---------------------20240310更新，代码更简洁，执行更高效----------------------------------------

补充一下下面代码的算法：
遍历文本所有行，检查行首字符的样式名是否是“脚注引用”，如果是的的话，选择上一行的文本，增加上一行文字的字符间距，使上一行移动一两个字符到行首字符为脚注引用的行，从而将该行行首的脚注引用移动到行中间。由于移动过程中有可能导致原来在上一行中间的脚注引用被移动到下一行行首，所以需要检查本次是否做过移动脚注引用的操作，只有没有移动过脚注引用，才能确保文档中不再存在位于行首的脚注引用。当然可以通过循环一直执行到没有移动过脚注引用再终止这个宏，但是文档比较长的话，可能因为反复循环导致Word失去响应，所以下面的宏只执行一次，执行完毕后提示用户可能需要再次执行。

Sub 将文档中所有在行首的脚注引用移动到非行首位置()
    Dim spacingTimes%, pos As Long, spacing As Double
    spacingTimes = 0 ' 字符间距调整次数
    ' 字符间距调整量，负数为紧缩。需通过试验，根据字体及文字大小调整为合适数值
    spacing = 0.1 
    Application.ScreenUpdating = False
    With Selection
        ' 光标定位至文档开头，此时Selection.Start为0
        .StartOf unit:=wdStory
        Do
            pos = .Start
            .GoToNext wdGoToLine
            ' 执行完上一条语句后光标位置没有发生变化则已完成文档遍历
            If pos = .Start Then Exit Do
            If Not .Characters(1).Style Is Nothing Then
                If .Characters(1).Style = "脚注引用" Then
                	' 选择上一行
                    .MoveUp
                    .EndKey unit:=wdLine, Extend:=wdExtend
                    ' 加宽上一行字距将行首脚注引用调整到下一行中间。此操作有可能导致
                    ' 原来在上一行中间的脚注引用被移动到下一行行首
                    .Font.spacing = .Font.spacing + spacing
                    spacingTimes = spacingTimes + 1
                End If
            End If
        Loop
    End With
    Application.ScreenUpdating = True
    ' 检查本次是否做过移动脚注引用的操作，只有没有移动过脚注引用，
    ' 才能确保文档中不再存在位于行首的脚注引用。
    If spacingTimes > 0 Then
        MsgBox "本次检查间距调整次数为：" & spacingTimes & "次。" & vbCrLf & _
            "需要再次执行以确保所有行首脚注引用全部移动到行首以外的位置！"
    Else
        MsgBox "恭喜！所有行首脚注引用已全部移动到行首以外的位置！"
    End If
End Sub