Word中每页插入两张图片（VBA+VSTO)

Word中每页插入两张图片（VBA+VSTO)
我们在平时的工作中经常会做一些简报，插入图片，一般情况下每页放两张图片比较美观，再配上文字说明就行了。可是每次都很烦人，图片不是大了就是小了，还要设置四周环绕或者其他环绕格式，调整高度、宽度…一系列的操作，如果是两张图片还好，再多一点就很头疼了。那么怎样用VBA一件操作呢，下面是我自己写的代码，希望能帮到你。
1.VBA代码：

Sub 每页两张图片()
    Dim myfile As FileDialog    Set myfile = Application.FileDialog(msoFileDialogFilePicker)    With myfile        .InitialFileName = "E:\工作文件" '这里输入你要插入图片的目标文件夹        If .Show = -1 Then            For Each FN In .SelectedItems                Selection.Text = Basename(FN) '这两句移到这里                Selection.Font.Name = "仿宋_GB2312"                Selection.Font.Size = 16                Selection.startof                 Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter                If Selection.Start = ActiveDocument.Content.End - 1 Then                '如光标在文末                    Selection.TypeParagraph '在文末添加一空段                Else                    Selection.MoveUp                End If                Set MyPic = Selection.InlineShapes.AddPicture(FileName:=FN, SaveWithDocument:=True) '按比例调整相片尺寸                WidthNum = MyPic.Width                '在此处修改相片宽,单位厘米                MyPic.Width = CentimetersToPoints(15) '宽10CM                MyPic.Height = CentimetersToPoints(9.5) '高10CM                If Selection.Start = ActiveDocument.Content.End - 1 Then '如光标在文末                    Selection.TypeParagraph '在文末添加一空段                Else                    Selection.MoveUp                End If            Next FN        Else        End If    End With    Set myfile = NothingEnd SubFunction Basename(FullPath) '取得文件名    Dim x, y    Dim tmpstring    tmpstring = FullPath    x = Len(FullPath)    For y = x To 1 Step -1        If Mid(FullPath, y, 1) = "\" Or _            Mid(FullPath, y, 1) = ":" Or _            Mid(FullPath, y, 1) = "/" Then            tmpstring = Mid(FullPath, y + 1)            Exit For        End If    Next    Basename = Left(tmpstring, Len(tmpstring) - 4)End Function 
    
    2.转成VSTO：
```VBA
 Private Sub Button19_Click(sender As Object, e As RibbonControlEventArgs) Handles Button19.Click
        Dim myfile As FileDialog
        With app.Application.FileDialog(Microsoft.Office.Core.MsoFileDialogType.msoFileDialogFilePicker)
            If .Show = -1 Then
                For Each FN In .SelectedItems
                    app.Selection.Text = Basename(FN) '这两句移到这里
                    app.Selection.Font.Name = "仿宋_GB2312"
                    app.Selection.Font.Size = 16
                    app.Selection.StartOf()
                    app.Selection.ParagraphFormat.Alignment = Microsoft.Office.Interop.Word.WdParagraphAlignment.wdAlignParagraphCenter
                    If app.Selection.Start = app.ActiveDocument.Content.End - 1 Then
                        '如光标在文末
                        app.Selection.TypeParagraph() '在文末添加一空段
                    Else
                        app.Selection.MoveUp()
                    End If
                    Dim Mypic = app.Selection.InlineShapes.AddPicture(FileName:=FN, SaveWithDocument:=True) '按比例调整相片尺寸
                    Dim WidthNum = Mypic.Width
                    '在此处修改相片宽,单位厘米
                    Mypic.Width = app.CentimetersToPoints(15) '宽10CM
                    Mypic.Height = app.CentimetersToPoints(10) '高10CM
                    If app.Selection.Start = app.ActiveDocument.Content.End - 1 Then '如光标在文末
                        app.Selection.TypeParagraph() '在文末添加一空段
                    Else
                        app.Selection.MoveUp()
                    End If
                Next FN
            Else
            End If
        End With
        myfile = Nothing
    End Sub
    Function Basename(ByVal FullPath As String) As String '取得文件名
        Dim x, y
        Dim tmpstring
        tmpstring = FullPath
        x = Len(FullPath)
        For y = x To 1 Step -1
            If Mid(FullPath, y, 1) = "\" Or
            Mid(FullPath, y, 1) = ":" Or
            Mid(FullPath, y, 1) = "/" Then
                tmpstring = Mid(FullPath, y + 1)
                Exit For
            End If
        Next
        Basename = Left(tmpstring, Len(tmpstring) - 4)
    End Function
End Class

来看看效果
优酷视频：http://v.youku.com/v_show/id_XNTEyNTA4MjI4OA==.html?x&sharefrom=android&sharekey=1fbf44645b50f44eed36a688452430595