admin管理员组文章数量:1130349
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：
```VBAPrivate Sub Button19_Click(sender As Object, e As RibbonControlEventArgs) Handles Button19.ClickDim myfile As FileDialogWith app.Application.FileDialog(Microsoft.Office.Core.MsoFileDialogType.msoFileDialogFilePicker)If .Show = -1 ThenFor Each FN In .SelectedItemsapp.Selection.Text = Basename(FN) '这两句移到这里app.Selection.Font.Name = "仿宋_GB2312"app.Selection.Font.Size = 16app.Selection.StartOf()app.Selection.ParagraphFormat.Alignment = Microsoft.Office.Interop.Word.WdParagraphAlignment.wdAlignParagraphCenterIf app.Selection.Start = app.ActiveDocument.Content.End - 1 Then'如光标在文末app.Selection.TypeParagraph() '在文末添加一空段Elseapp.Selection.MoveUp()End IfDim Mypic = app.Selection.InlineShapes.AddPicture(FileName:=FN, SaveWithDocument:=True) '按比例调整相片尺寸Dim WidthNum = Mypic.Width'在此处修改相片宽,单位厘米Mypic.Width = app.CentimetersToPoints(15) '宽10CMMypic.Height = app.CentimetersToPoints(10) '高10CMIf app.Selection.Start = app.ActiveDocument.Content.End - 1 Then '如光标在文末app.Selection.TypeParagraph() '在文末添加一空段Elseapp.Selection.MoveUp()End IfNext FNElseEnd IfEnd Withmyfile = NothingEnd SubFunction Basename(ByVal FullPath As String) As String '取得文件名Dim x, yDim tmpstringtmpstring = FullPathx = Len(FullPath)For y = x To 1 Step -1If Mid(FullPath, y, 1) = "\" OrMid(FullPath, y, 1) = ":" OrMid(FullPath, y, 1) = "/" Thentmpstring = Mid(FullPath, y + 1)Exit ForEnd IfNextBasename = Left(tmpstring, Len(tmpstring) - 4)End Function
End Class
来看看效果
优酷视频：==.html?x&sharefrom=android&sharekey=1fbf44645b50f44eed36a688452430595
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：
```VBAPrivate Sub Button19_Click(sender As Object, e As RibbonControlEventArgs) Handles Button19.ClickDim myfile As FileDialogWith app.Application.FileDialog(Microsoft.Office.Core.MsoFileDialogType.msoFileDialogFilePicker)If .Show = -1 ThenFor Each FN In .SelectedItemsapp.Selection.Text = Basename(FN) '这两句移到这里app.Selection.Font.Name = "仿宋_GB2312"app.Selection.Font.Size = 16app.Selection.StartOf()app.Selection.ParagraphFormat.Alignment = Microsoft.Office.Interop.Word.WdParagraphAlignment.wdAlignParagraphCenterIf app.Selection.Start = app.ActiveDocument.Content.End - 1 Then'如光标在文末app.Selection.TypeParagraph() '在文末添加一空段Elseapp.Selection.MoveUp()End IfDim Mypic = app.Selection.InlineShapes.AddPicture(FileName:=FN, SaveWithDocument:=True) '按比例调整相片尺寸Dim WidthNum = Mypic.Width'在此处修改相片宽,单位厘米Mypic.Width = app.CentimetersToPoints(15) '宽10CMMypic.Height = app.CentimetersToPoints(10) '高10CMIf app.Selection.Start = app.ActiveDocument.Content.End - 1 Then '如光标在文末app.Selection.TypeParagraph() '在文末添加一空段Elseapp.Selection.MoveUp()End IfNext FNElseEnd IfEnd Withmyfile = NothingEnd SubFunction Basename(ByVal FullPath As String) As String '取得文件名Dim x, yDim tmpstringtmpstring = FullPathx = Len(FullPath)For y = x To 1 Step -1If Mid(FullPath, y, 1) = "\" OrMid(FullPath, y, 1) = ":" OrMid(FullPath, y, 1) = "/" Thentmpstring = Mid(FullPath, y + 1)Exit ForEnd IfNextBasename = Left(tmpstring, Len(tmpstring) - 4)End Function
End Class
来看看效果
优酷视频：==.html?x&sharefrom=android&sharekey=1fbf44645b50f44eed36a688452430595
本文标签： Word中每页插入两张图片（VBAVSTO)
版权声明：本文标题：Word中每页插入两张图片（VBA+VSTO) 内容由热心网友自发贡献，该文观点仅代表作者本人， 转载请联系作者并注明出处：https://it.en369.cn/jiaocheng/1706687237a420103.html， 本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌抄袭侵权/违法违规的内容，一经查实，本站将立刻删除。
发表评论