如何用VBA让word中一页并排插入两张图片并调整至合适大小？

楼主 kevinchengcw	Q: 如何用VBA让word中一页并排插入两张图片并调整至合适大小？ A: 代码如下： Sub test() Dim FN As String, N%, W#, H#, PW#, PH# With ActiveDocument.PageSetup '以下设置纸型及页边距（A4，页边距2cm），并计算出图片应有的宽高 .Orientation = wdOrientLandscape .TopMargin = CentimetersToPoints(2) .BottomMargin = CentimetersToPoints(2) .LeftMargin = CentimetersToPoints(2) .RightMargin = CentimetersToPoints(2) .Gutter = CentimetersToPoints(0) .PageWidth = CentimetersToPoints(29.7) .PageHeight = CentimetersToPoints(21) PW = (.PageWidth - .LeftMargin - .RightMargin) / 2 PH = .PageHeight - .TopMargin - .LeftMargin End With FN = Dir(ThisDocument.Path & "\.jpg") '循环当前文件目录下各个jpg文件 Do While FN <> "" '当文件名不为空时持续循环 Selection.InlineShapes.AddPicture FN '插入当前循环到的jpg文件 FN = Dir '循环到下一个文件 Loop For N = 1 To ActiveDocument.InlineShapes.Count '下面循环已插入的各个文件并调整尺寸 With ActiveDocument.InlineShapes(N) W = .Width '取得宽与高 H = .Height If W / H >= PW / PH Then '如果图片的宽高比大于应设置的宽高比，则 .Width = PW '调整宽度为应设置的宽度，高度按调整前后的宽度比进行缩放 .Height = PH W / PW Else '如果图片的宽高比小于应设置的宽高比，则 .Height = PH '调整高度为应设置的高度，宽度按调整前后的高度比进行缩放 .Width = PW * H / PH End If End With Next N ThisDocument.Save '文件保存 End Sub 附示例文件。 test.rar
2楼 xyh9999	哈哈,K哥都跑Word中去用VBA了,我们要在后面跟上! 好好学习!
3楼 csb2000cn	Selection.InlineShapes.AddPicture FN '插入当前循环到的jpg文件请问斑竹，为何运行到上一语句时会出现如下对话框
4楼 tangqingfu	学习ing……
5楼 0Mouse	Sub test() Dim FN As String, N%, W#, H#, PW#, PH# With ActiveDocument.PageSetup '以下设置纸型及页边距（A4，页边距2cm），并计算出图片应有的宽高 .Orientation = wdOrientLandscape .TopMargin = CentimetersToPoints(2) .BottomMargin = CentimetersToPoints(2) .LeftMargin = CentimetersToPoints(2) .RightMargin = CentimetersToPoints(2) .Gutter = CentimetersToPoints(0) .PageWidth = CentimetersToPoints(29.7) .PageHeight = CentimetersToPoints(21) PW = (.PageWidth - .LeftMargin - .RightMargin) / 2 PH = .PageHeight - .TopMargin - .LeftMargin End With FN = Dir("D:\图书案例\图片\.jpg") Do While FN <> "" Selection.InlineShapes.AddPicture "D:\图书案例\图片\" & FN 'FN只是返回文件名，需要加上路径 FN = Dir Loop For N = 1 To ActiveDocument.InlineShapes.Count With ActiveDocument.InlineShapes(N) W = .Width H = .Height If W / H >= PW / PH Then .Width = PW 0.99 '理论上讲图片的宽度应该刚好占版心宽度的一半，两个一半刚好撑满整个宽度，实际运用时应将图片再缩小一小点，否则两张图片还是可能处于不同的页，两张图片中间留出一条小缝也更好一些。 ' .Height = PH * W / PW '插入图片时默认是锁定纵横比的，调整宽或高即可，两个都调反而有误。 Else .Height = PH * 0.99 ' .Width = PW * H / PH End If End With Next N ThisDocument.Save End Sub
6楼 0Mouse	嗯，由于是通过比例换算得到的，所以锁不锁定纵横比都没关系，宽高调整语句确实还是应该都加上，不过公式确实有误，应该下面这个才对，是按照图片等比例缩放，而不是根据PW、PH大小等比例缩放。 For N = 1 To ActiveDocument.InlineShapes.Count '循环插入文档中的每一张图片 With ActiveDocument.InlineShapes(N) '对第N张图片进行处理 W = .Width '将图片的当前宽度值赋值给变量W H = .Height '将图片的当前高度值赋值给变量H If W / H >= PW / PH Then '将调整尺寸前图片的宽高比值与图片所能占据的最大宽高比值进行比较以判断应该对图片的高度还是宽度进行调整 .Width = PW * 0.99 '将图片宽度修改为所能占据最大宽度的99% .Height = H * PW / W Else .Height = PH * 0.99 '将图片高度修改为所能占据最大高度的99% .Width = W * PH / H End If End With Next
7楼 0Mouse	貌似还是先设置等比例缩放，再调整高或宽比较省事。 For N = 1 To ActiveDocument.InlineShapes.Count '循环插入文档中的每一张图片 With ActiveDocument.InlineShapes(N) '对第N张图片进行处理 W = .Width '将图片的当前宽度值赋值给变量W H = .Height '将图片的当前高度值赋值给变量H .LockAspectRatio = msoTrue '锁定纵横比（即令宽高等比例缩放） If W / H >= PW / PH Then '将调整尺寸前图片的宽高比值与图片所能占据的最大宽高比值进行比较以判断应该对图片的高度还是宽度进行调整 .Width = PW * 0.99 '将图片宽度修改为所能占据最大宽度的99% Else .Height = PH * 0.99 '将图片高度修改为所能占据最大高度的99% End If End With Next