【vba】在word文档上每一页插入图片\插入画笔线条

由于某些规范要求每一页都批阅痕迹，工程量太大不得不出此下策略，复制以下代码替换路径即可。然后配合wps设置快捷键即可一键打钩

Sub dagouPer()

Dim i&, sha As Shape
Application.ScreenUpdating = False
    '文件选择对话框

Selection.HomeKey wdStory '如果删掉√会打在一个地方


Const fileName As String = "D:\py_checkFolder\dagou.png" '替换路径即可

Const fileName2 As String = "D:\py_checkFolder\dagou2.png"

Application.Browser.Target = wdBrowsePage '设置按页浏览

    

For i = 1 To ActiveDocument.ActiveWindow.ActivePane.Pages.Count

    Selection.MoveDown wdParagraph, 1 '下移一段
    
  
    If i <> 1 And i <> 2 And i Mod 2 <> 0 Then
        Set sha = Selection.InlineShapes.AddPicture(fileName:=fileName, LinkToFile:=False, SaveWithDocument:=True).ConvertToShape '插入图形
        With sha
            .WrapFormat.Type = wdWrapFront '设置文字环绕方式，wdwrapfront置于文字上方，wdwrapbehind置于文字下方，wdwrapthrough四周环绕……

            .LockAspectRatio = msoCTrue '锁定纵横比

            .Height = 450

        End With

    End If
  
      
    If i <> 1 And i <> 2 And i Mod 2 = 0 Then
        Set sha = Selection.InlineShapes.AddPicture(fileName:=fileName2, LinkToFile:=False, SaveWithDocument:=True).ConvertToShape '插入图形
        With sha
            .WrapFormat.Type = wdWrapFront

            .LockAspectRatio = msoCTrue

            .Height = 450

        End With

    End If
    
    Application.Browser.Next '走到下一页
    
NextIteration:
    Next i

Application.ScreenUpdating = True
    
End Sub