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

admin管理员组

文章数量:1122847

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

• 按下 ALT + F11 打开 Visual Basic for Applications (VBA) 编辑器。
• 在左侧的项目资源管理器中，选择你的工作簿。
• 插入一个新的模块（在菜单中选择 Insert -> Module）。
• 在新模块中输入以下代码：

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

本文标签： 画笔线条插入图片文档VBA