Word-Vba:InlineShapes.Addpicture图像比其上一个图像高

时间:2016-03-28 07:30:54

标签: vba ms-word word-vba

Sub GetPictures()     Dim sPic As String     Dim sPath As String     Dim sCount As Long

sPath = "G:\Images\Alphabet_Lower_Case\"
sPic = Dir(sPath & "*.jpg")

Do While sPic <> ""

    Selection.InlineShapes.AddPicture _
      FileName:=sPath & sPic, _
      LinkToFile:=False, SaveWithDocument:=True

    With Selection
        With .Borders(wdBorderLeft)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth300pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderRight)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth300pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderTop)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth300pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderBottom)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth300pt
            .Color = wdColorAutomatic
        End With
        .Borders.Shadow = False
    End With

    Selection.Paragraphs.Format.Alignment = wdAlignParagraphCenter

    sPic = Dir

    With Selection
    .Collapse Direction:=wdCollapseEnd
    .TypeParagraph
    End With
Loop

With ThisDocument.PageSetup.TextColumns
 .SetCount NumColumns:=2
End With

Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Cut

End Sub

'有关如何将右侧图像降低到与左侧(上一个)相同水平的任何想法?例如。 b坐在比应有的高度并且正在遮挡边界。

所有图片都具有相同的600x600尺寸。 请参阅以下输出以获得说明。 a&b 这是一个屏幕截图,'b'后面的网格显示了移位。 preview

0 个答案:

没有答案