邮件合并中相片太大且不统一的问题要如何解决？

香川群子

原帖由 szqhb 于 2011-6-22 10:10 发表
虽然不是很懂，但还是很感谢你

再转发一个代码，可以统一调整大小的。

1. 
   
2. Sub 图片统一大小()
   
3. On Error Resume Next
   
4. Dim mywidth
   
5. Dim myheight
   
6. Application.ScreenUpdating = False '关闭屏幕更新
   
7. mywidth = Val(InputBox(Prompt:="单位为厘米(cm);如果输入为0，则图片保持原始纵横比,宽度根据输入的高度数值自动调整；", Title:="请输入图片宽度", Default:="0")) * 28.35
   
8. myheight = Val(InputBox(Prompt:="单位为厘米(cm);如果输入为0，则图片保持原始纵横比,高度根据输入的宽度数值自动调整；", Title:="请输入图片高度", Default:="0")) * 28.35
   
9. '------------------------------------------------------------------
   
10. '调整嵌入式图形
    
11. Dim pic As InlineShape
    
12. For Each pic In ActiveDocument.InlineShapes
    
13. If mywidth = "0" Then
    
14. pic.Height = myheight
    
15. pic.ScaleWidth = pic.ScaleHeight
    
16. ElseIf myheight = "0" Then
    
17. pic.Width = mywidth
    
18. pic.ScaleHeight = pic.ScaleWidth
    
19. Else
    
20. pic.Width = mywidth
    
21. pic.Height = myheight
    
22. End If
    
23. Next
    
24. '调整浮动式图形
    
25. Dim tu As Shape
    
26. For Each tu In ActiveDocument.Shapes
    
27. If mywidth = "0" Then
    
28. tu.Height = myheight
    
29. ElseIf myheight = "0" Then
    
30. tu.Width = mywidth
    
31. Else
    
32. tu.LockAspectRatio = msoFalse
    
33. tu.Width = mywidth
    
34. tu.Height = myheight
    
35. End If
    
36. Next
    
37.   Application.ScreenUpdating = True '恢复屏幕更新
    
38. End Sub

复制代码

gaozengxun

很适用，学学习习。

dfzaq

很实用，学习学习！

ghinc

你好！感谢！加我QQ  750737855  有事求教

gmafhnpl

把照片源文件统一大小就行了，费那劲还写代码，直接从根源上解决呗