对当前选定的图片设置缩放比例为100%的VBA怎样写？谢谢!

foshan

对当前选定的图片设置缩放比例为100%(将图片还原为原始尺寸)的VBA怎样写？以下的代码对上传的文档(文档中的图片是用扫描仪扫描后导出的图片)执行时发生错误，请大家帮忙指正，谢谢!

Sub 恢复()
    With ActiveDocument.Shapes(1)
        .ScaleHeight 1, True
        .ScaleWidth 1, True
    End With
End Sub

 

Tpzf9XZt.rar (77.67 KB, 下载次数: 49)

2007-1-26 15:04 上传

点击文件名下载附件
对当前选定的图片设置缩放比例为100%的VBA怎样写？谢谢!

chylhr

'出现错误的原因是由于文档中没有Shape对象,先将InlineShape转化为Shape即可

Sub 恢复()
ActiveDocument.InlineShapes(1).ConvertToShape
With ActiveDocument.Shapes(1)
        .ScaleHeight 1, True
        .ScaleWidth 1, True
    End With
End Sub

foshan

谢谢!用了上面的代码，对第一页的“副本”图片起作用，但如果直接点击第二页的图片，然后运行宏，就出现错误提示，图片并没有恢复到原来的大小。

请大家继续帮忙解决，谢谢!

chylhr

又一个bug(在VBA中这样的bug可真多).

解决办法很简单:直接点击第二页的图片,再点击一个图文框的上框或干脆移动一下图片的位置就可以运行宏了(不知为什么会这样?).

守柔

QUOTE:

以下是引用chylhr在2007-1-26 17:32:33的发言：

又一个bug(在VBA中这样的bug可真多).

解决办法很简单:直接点击第二页的图片,再点击一个图文框的上框或干脆移动一下图片的位置就可以运行宏了(不知为什么会这样?).

谢谢chylhr!

我结合上次foshan兄的问题，以及现在的情况，分析了一下，觉得问题出在WORD图形转换上。

我们可以对比一下第二页的图片，选定时，图片外框是“嵌入型”，但格式/版式中是“四周型”，这是转化不完全的标志，记得2003刚出来时，与2000的图形很不兼容。如果我们重设一下嵌入型，或者四周型时，才彻底转换了。

以下代码在我机器上通过，请foshan兄和chylrh兄测试一下：

Sub Test()
    Dim myShape As Variant
    With Selection
        If .Type = wdSelectionInlineShape Then
            Set myShape = .InlineShapes(1).ConvertToShape
            With myShape
                .ScaleHeight 1, True
                .ScaleWidth 1, True
            End With
        End If
    End With
End Sub

如果通过，请foshan兄把它完善一下，即如果不是嵌入式时，直接应用图形大小设置。

foshan

谢谢守柔斑竹!对于单个图片，以上代码可行，但我对word不熟悉，又急于用到，所以继续请教：我想对上传文档中的所有图片一次过恢复原来的大小，而将代码套入到以下的代码中，运行时出错，不知何故。

 Dim b As Shape
        For Each b In ActiveDocument.Shapes   '(在其中循环)
            If b.Type = wdSelectionInlineShape Then
                Set myShape = b.ConvertToShape
                With myShape
                    .ScaleHeight 1, True
                    .ScaleWidth 1, True
                End With
            End If
        Next

还有，上次守柔斑竹给我提供的代码以下代码，我还是不会将其领会，不知如何加上今次的功能要求，请大家特别是守柔斑竹帮忙。谢谢!

问：如何用代码将文档中所有的图片的大小比例一次性设置为100%？

守柔版主答：

Sub Example()
    Dim oShape As InlineShape, aShape As Shape
    For Each oShape In Me.InlineShapes
        With oShape
            If .Type = wdInlineShapePicture Then
                Set aShape = .ConvertToShape
                With aShape
                    .WrapFormat.Type = 1
                    .ScaleHeight 1, True, msoScaleFromMiddle
                    .ScaleWidth 1, True, msoScaleFromMiddle
                End With
            End If
        End With
    Next
End Sub

附件中图片2出错，我一时也没整明白。

http://club.excelhome.net/viewthread.php?tid=215017&replyID=&skin=0

守柔

QUOTE:

以下是引用foshan在2007-1-26 23:28:04的发言：

谢谢守柔斑竹!对于单个图片，以上代码可行，但我对word不熟悉，又急于用到，所以继续请教：我想对上传文档中的所有图片一次过恢复原来的大小，而将代码套入到以下的代码中，运行时出错，不知何故。

 http://club.excelhome.net/viewthread.php?tid=215017&replyID=&skin=0

TO foshan兄，并非是Word代码生涩，止于个人对于Word的应用习惯。

上述代码并非“代码”本身之故，原因还是我在上楼说的问题，图片转换过程出现了问题。

试一下以下代码：

Sub Test()
    Dim myShape As Variant
    Application.ScreenUpdating = False
    With ActiveDocument
        For Each myShape In .Shapes
            With myShape
                .ScaleHeight 1, True
                .ScaleWidth 1, True
            End With
        Next
        For Each myShape In .InlineShapes
            myShape.Select
            Set myShape = .InlineShapes(1).ConvertToShape
            With myShape
                .ScaleHeight 1, True, msoScaleFromMiddle
                .ScaleWidth 1, True, msoScaleFromMiddle
            End With
        Next
    End With
    Application.ScreenUpdating = True
End Sub
请注意，我加了一句“myShape.select”

我已在原链接中进行了多次测试，请您测试后将结果告诉我。

foshan

再次感谢 守柔 斑竹!!! 代码可行，极大地提高了工作效率!!![em24][em23][em22]

伊婷

额。好强大的功能！ 我也受用了。。谢谢版主！

莫悠悠

WORD缩放比例设置VBA