如何实现每一页中的所有图文框设定在指定的位置？？？

foshan

小弟最近因工作需要需将合同扫描到电脑上，用扫描仪将合同扫描后输出到WORD后，需手工地将拖动每一页中的图文框的位置，但每一页的图文框相对于该页的位置来讲，每页中的图文框的相对位置都是一样的。通过录制宏是无法得到相关的代码的。

请大家帮忙编写一个程序，实现一次性统一将文档中每一页中的所有图文框设定在指定的位置：对文档中的每一页中的图文框的位置均是相对于该面的水平位置相对于页面2厘米，垂直位置相对于页面2厘米。

谢谢大家!!!

6T1XlXjs.rar (63.57 KB, 下载次数: 22)

2007-1-19 11:05 上传

点击文件名下载附件
如何实现每一页中的所有图文框设定在指定的位置？？？

[此贴子已经被作者于2007-1-19 11:12:25编辑过]

守柔

请foshan兄在此基础上修改：

Sub Example()
    Dim i As Frame
    For Each i In Me.Frames
        i.RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
        i.HorizontalPosition = Word.CentimetersToPoints(2)
        i.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
        i.VerticalPosition = Word.CentimetersToPoints(2)
    Next
End Sub

foshan

谢谢守柔斑竹!

还有问题请教：如何用代码设置图片的大小缩放比例？？？以及将文档中所有的图片的大小比例一次性设置为100%，并且将设置
  图片的版式中的环绕方式为“紧密型”？？？？

谢谢大家帮忙!

   zFu6w3M0.rar (33.1 KB, 下载次数: 23)

2007-1-19 14:28 上传

点击文件名下载附件

[此贴子已经被作者于2007-1-19 14:28:37编辑过]

守柔

佛山兄，时间关系，我无法更多时间测试，你看一下：

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出错，我一时也没整明白。

foshan

Sub 设置A4页面()
'

    Selection.WholeStory
    With ActiveDocument.Styles(wdStyleNormal).Font
        If .NameFarEast = .NameAscii Then
            .NameAscii = ""
        End If
        .NameFarEast = ""
    End With
    With ActiveDocument.PageSetup
        .PageWidth = CentimetersToPoints(21)
        .PageHeight = CentimetersToPoints(29.7)
    End With
    Dim i As Frame
    For Each i In Me.Frames
        i.RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
        i.HorizontalPosition = Word.CentimetersToPoints(2)
        i.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
        i.VerticalPosition = Word.CentimetersToPoints(2)
    Next
    Dim a As InlineShape
    For Each a In ActiveDocument.InlineShapes   '(在其中循环)
        a.ScaleHeight = 37
        a.ScaleWidth = 37
        'a.WrapFormat.Type = wdWrapThrough '紧密型
    Next

    Dim b As Shape
    For Each b In ActiveDocument.Shapes   '(在其中循环)
        b.ScaleHeight 1, True
        b.ScaleWidth 1, True

        'a.Height = 100
        '    a.Width = 100
        'a.WrapFormat.Type = wdWrapThrough '紧密型
         MsgBox "InlineShape = 2"
    Next
    Set doc = ActiveDocument
    MsgBox "InlineShape = " & doc.InlineShapes.Count & _
           vbCr & "Shapes = " & doc.Shapes.Count

    '    ActiveDocument.Shapes.SelectAll

End Sub

foshan

发现一个奇怪的问题，我在第五楼的代码，如果把第二个图片先手动设置环绕版式为“紧密型”，然后再执行我在第五楼的代码，就可正常将第二个图片还原为原来的大小。[em06][em06][em06][em06][em06][em06][em06]

foshan

经 守柔版主的多番指教，完整的代码如下：

Sub 设置A4页面()
'
    Dim myShape As Variant
    Application.ScreenUpdating = False    With ActiveDocument.PageSetup
        .PageWidth = CentimetersToPoints(21)
        .PageHeight = CentimetersToPoints(29.7)
    End With
    Dim i As Frame

    With ActiveDocument
        For Each myShape In .Shapes
            With myShape
                .ScaleHeight 1, True
                .ScaleWidth 1, True
                .Left = wdShapeCenter
            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
                .Left = wdShapeCenter
            End With
        Next
    End With
   
        For Each i In Me.Frames
        i.RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
        i.HorizontalPosition = Word.CentimetersToPoints(2)
        i.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
'        i.VerticalPosition = Word.CentimetersToPoints(2)
    Next

    Application.ScreenUpdating = True