在Word中 图片 按缩放大小，去除原始大小 word的宏

river1010

求助：在Word中 图片 按在文档中的“缩放大小”生成，去除“原始尺寸”的 word的批处理宏！
原因：虽然在word中可以自由拉动图片的大小显示，如果需要图片拷贝出来，就会按“原始尺寸”复制出来，当然这图片大小就不标准了，有可能造成变形及缩放大小。
附图：

以图举例：
现在需求的是用宏把尺寸按等比例为：高4.55cm，宽7.27cm为"原始尺寸"。

在此，周老大及各位高手出马看看能否编译VBA批处理宏。谢谢！！！在线等。。。。试！

river1010

没有人理会，难道。。。。。。。。我只有自己顶。

river1010

48小时内，再顶。。。。。。。。。

river1010

72小时，后，再顶。。。

sqhsqhli

Sub 图片统一大小()
On Error Resume Next
Dim mywidth
Dim myheight
Application.ScreenUpdating = False '关闭屏幕更新
mywidth = Val(InputBox(Prompt:="单位为厘米(cm);如果输入为0，则图片保持原始纵横比,宽度根据输入的高度数值自动调整；", Title:="请输入图片宽度", Default:="0")) * 28.35
myheight = Val(InputBox(Prompt:="单位为厘米(cm);如果输入为0，则图片保持原始纵横比,高度根据输入的宽度数值自动调整；", Title:="请输入图片高度", Default:="0")) * 28.35
'------------------------------------------------------------------
'调整嵌入式图形
Dim pic As InlineShape
For Each pic In ActiveDocument.InlineShapes
If mywidth = "0" Then
pic.Height = myheight
pic.ScaleWidth = pic.ScaleHeight
ElseIf myheight = "0" Then
pic.Width = mywidth
pic.ScaleHeight = pic.ScaleWidth
Else
pic.Width = mywidth
pic.Height = myheight
End If
Next
'调整浮动式图形
Dim tu As Shape
For Each tu In ActiveDocument.Shapes
If mywidth = "0" Then
tu.Height = myheight
ElseIf myheight = "0" Then
tu.Width = mywidth
Else
tu.LockAspectRatio = msoFalse
tu.Width = mywidth
tu.Height = myheight
End If
Next
  Application.ScreenUpdating = True '恢复屏幕更新
End Sub

river1010

谢谢。5楼老大！
但，不是我说的处理的结果。我的意思是。只要缩放后的图片大小，至少COPY出来。图不会缩放成原大。放大后的图片就没有意义了！

不喜不悲

帮顶一下，最近也遇到这问题，希望有高人出来指点下

ly8421

Sub 批量插入相同大小图片Macro()
Mywidth = 4.55 '图片宽度（厘米）
Myheigth =7.27 '图片高度（厘米）
For Each iShape In ActiveDocument.InlineShapes
iShape.Height = 28.345 * Myheigth
iShape.Width = 28.345 * Mywidth
Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
Next iShape
End Sub