MicrosoftWord / グリッドに合わせる

Access にあるのに Word にない処理。 ページの設定がおかしくなって、どうしても使いたくなったので作成。

Sub fitToGrid()

'
' シェイプをグリッドに強制的に合わせる(2.5pt)
' なんか微妙にずれている図形を一気に合わせる
' Accessのグリッド合わせと同等の処理
'
    
    ' グリッドの設定
    With ActiveDocument
        .SnapToGrid = True
        .SnapToShapes = False
        .GridDistanceHorizontal = MillimetersToPoints(0.9) '2.5pt
        .GridDistanceVertical = MillimetersToPoints(0.9) '2.5pt
        .GridOriginHorizontal = MillimetersToPoints(0)
        .GridOriginVertical = MillimetersToPoints(0)
        .GridSpaceBetweenHorizontalLines = 2
        .GridSpaceBetweenVerticalLines = 2
        .GridOriginFromMargin = False
    End With
    
    ' グリッドの表示
    Options.DisplayGridLines = True
    
    ' ドキュメント内のすべての図形でループ
    For Each shp In ActiveDocument.Content.ShapeRange
    
        ' オートシェイプの書式設定で、
        ' 「代わりに表示する文字列」に"NOFIT"が含まれていたら、パス
        If InStr(shp.AlternativeText, "NOFIT") = 0 Then
        
            ' オートシェイプの基準をページに合わせる
            ' この指定で「文字列と一緒に移動する」は外れる
            shp.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
            shp.RelativeVerticalPosition = wdRelativeVerticalPositionPage
            
            ' アンカーを段落に固定する(にしない)
            Selection.ShapeRange.LockAnchor = False
            ' 表のセル内に配置する
            Selection.ShapeRange.LayoutInCell = True
            ' オーバーラップさせる
            Selection.ShapeRange.WrapFormat.AllowOverlap = True
            
            ' 位置を四捨五入で合わせる
            shp.Left = Int((shp.Left + (ActiveDocument.GridDistanceHorizontal / 2)) / ActiveDocument.GridDistanceHorizontal) * ActiveDocument.GridDistanceHorizontal
            shp.Top = Int((shp.Top + (ActiveDocument.GridDistanceVertical / 2)) / ActiveDocument.GridDistanceVertical) * ActiveDocument.GridDistanceVertical
            ' サイズを四捨五入で合わせる
            shp.Width = Int((shp.Width + (ActiveDocument.GridDistanceHorizontal / 2)) / ActiveDocument.GridDistanceHorizontal) * ActiveDocument.GridDistanceHorizontal
            shp.Height = Int((shp.Height + (ActiveDocument.GridDistanceVertical / 2)) / ActiveDocument.GridDistanceVertical) * ActiveDocument.GridDistanceVertical
        
        End If
    
    Next shp

End Sub