ExcelTip.Net留存知识帖 ---【注:附件之前被网盘供应商清空后,现已修复-现已修复-现已修复为本地下载!】
现在位置:首页 > 我的酷贴 > Word > 如何用VBA让word中一页并排插入两张图片并调整至合适大小?

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

作者:绿色风 分类: 时间:2022-08-18 浏览:139
楼主
kevinchengcw
Q: 如何用VBA让word中一页并排插入两张图片并调整至合适大小?
A: 代码如下:
  1. Sub test()
  2. Dim FN As String, N%, W#, H#, PW#, PH#
  3. With ActiveDocument.PageSetup  '以下设置纸型及页边距(A4,页边距2cm),并计算出图片应有的宽高
  4.     .Orientation = wdOrientLandscape
  5.     .TopMargin = CentimetersToPoints(2)
  6.     .BottomMargin = CentimetersToPoints(2)
  7.     .LeftMargin = CentimetersToPoints(2)
  8.     .RightMargin = CentimetersToPoints(2)
  9.     .Gutter = CentimetersToPoints(0)
  10.     .PageWidth = CentimetersToPoints(29.7)
  11.     .PageHeight = CentimetersToPoints(21)
  12.     PW = (.PageWidth - .LeftMargin - .RightMargin) / 2
  13.     PH = .PageHeight - .TopMargin - .LeftMargin
  14. End With
  15. FN = Dir(ThisDocument.Path & "\*.jpg") '循环当前文件目录下各个jpg文件
  16. Do While FN <> "" '当文件名不为空时持续循环
  17.     Selection.InlineShapes.AddPicture FN '插入当前循环到的jpg文件
  18.     FN = Dir '循环到下一个文件
  19. Loop
  20. For N = 1 To ActiveDocument.InlineShapes.Count '下面循环已插入的各个文件并调整尺寸
  21.     With ActiveDocument.InlineShapes(N)
  22.         W = .Width '取得宽与高
  23.         H = .Height
  24.         If W / H >= PW / PH Then '如果图片的宽高比大于应设置的宽高比,则
  25.             .Width = PW   '调整宽度为应设置的宽度,高度按调整前后的宽度比进行缩放
  26.             .Height = PH * W / PW
  27.         Else    '如果图片的宽高比小于应设置的宽高比,则
  28.             .Height = PH  '调整高度为应设置的高度,宽度按调整前后的高度比进行缩放
  29.             .Width = PW * H / PH
  30.         End If
  31.     End With
  32. Next N
  33. ThisDocument.Save '文件保存
  34. 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

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素, 经与ExcelTip.Net站长Apolloh商议并征得其同意, 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示, 供有需要的人士查询使用,也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议, 可与本人沟通提出,或于本站点留言,我们会尽快处理。 在此,感谢ExcelTip.Net站长Apolloh的支持,感谢本站点所有人**绿色风(QQ:79664738)**的支持与奉献,特此鸣谢!
------本人网名**KevinChengCW(QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表
sitemap