一次更改所有图片大小的宏的问题

henanfeng · 发表于 2008-12-13 13:52

想编写一个宏
首先要求输入图片的长和宽
然后把所有图片（嵌入型、浮动式）的长和宽都变成同样的。

neverquest · 发表于 2008-12-13 14:21

供参考：
Sub 插入图片到当前单元格()
On Error Resume Next
Dim MR As Range
For Each MR In Selection
If Not IsEmpty(MR) Then
MR.Select
ML = MR.Left
MT = MR.Top
MW = MR.Width
MH = MR.Height
ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select
Selection.ShapeRange.Fill.UserPicture _
ActiveWorkbook.Path & "\" & MR.Value & ".jpg" '当前文件所在目录下以当前单元内容为名称的.jpg图片
End If
Next
End Sub

dsp5000 · 发表于 2008-12-13 14:29

对于所有类型的图片
Sub kk()
Dim a As Shape
For Each a In ActiveDocument.Shapes '(在其中循环)
a.Width = 126.4 '(图像宽)
a.Height = 126.4 '(图像高)
Next
End Sub

henanfeng · 发表于 2008-12-13 14:35

2楼：文不对题啊
3楼：如果仅仅指定统一高度，而高度保持原始纵横比怎么办？

dsp5000 · 发表于 2008-12-13 14:45

对于所有类型的图片
Sub kk()
Dim a As Shape
For Each a In ActiveDocument.Shapes '(在其中循环)
'a.Width = 126.4 '(图像宽)
a.Height = 126.4 '(图像高)
Next
End Sub

henanfeng · 发表于 2008-12-13 14:57

意思是只定义一个么？好像只定义宽度或者高度，不定义的也不会自动保持纵横比的

dsp5000 · 发表于 2008-12-13 15:09

原帖由 henanfeng 于 2008-12-13 14:57 发表
意思是只定义一个么？好像只定义宽度或者高度，不定义的也不会自动保持纵横比的

你自己试过吗？

henanfeng · 发表于 2008-12-13 15:26

手动肯定是可以的le，但是在宏中执行却不行啊。我的宏是：

Sub 图片统一大小()
Application.ScreenUpdating = False '关闭屏幕更新
On Error Resume Next
myWidth = Val(InputBox(Prompt:="请输入图片宽度", Default:=100))
Dim pic As InlineShape

For Each pic In ActiveDocument.InlineShapes '(在其中循环) '嵌入式图形
pic.Width = myWidth
Next
End Sub
但是，执行了后，高度不能自动调整，加了.LockAspectRatio=msotrue 也不行啊

sylun · 发表于 2008-12-13 16:02

试试将循环语句部分改为：
For Each pic In ActiveDocument.InlineShapes
pic.Width = myWidth
pic.ScaleHeight = pic.ScaleWidth
Next

henanfeng · 发表于 2008-12-13 16:17

感谢sylun！
上面果然好用，我等水平太臭啊！

		自动登录	找回密码
密码			免费注册

[求助] 一次更改所有图片大小的宏的问题