word中批量缩小图片，删除行，删除重复图片vba代码

word中批量缩小图片，删除行，删除重复图片vba代码

    好几年不打印微博了，复制后排了个版，改进了以前写的几个函数。

Sub sizepic()
'
' 缩小微博图片
'
'
Dim n '图片个数

    On Error Resume Next '忽略错误

    For n = 1 To ActiveDocument.InlineShapes.Count 'Shapes类型图片
    Debug.Print ActiveDocument.InlineShapes(n).Width
      If ActiveDocument.InlineShapes(n).Width > 264 Then
         wh = ActiveDocument.InlineShapes(n).Height / ActiveDocument.InlineShapes(n).Width
        ActiveDocument.InlineShapes(n).Width = 264 '设置图片高度为 400px
        ActiveDocument.InlineShapes(n).Height = 198 * wh '设置图片宽度300px
      End If
    Next n
End Sub

Sub delpic()

For n = ActiveDocument.InlineShapes.Count To 1 Step -1
    Debug.Print ActiveDocument.InlineShapes(n).Width
    If ActiveDocument.InlineShapes(n).Width = 37.5 Then
        ActiveDocument.InlineShapes(n).Delete
    End If
Next n

End Sub

Sub delline()
'删除以输入字符结尾的短行
'ftext1 = InputBox("请输入要删除行中包含的字符(支持通配符)", "删除微博中多余的内容")
Dim i As Paragraph
n = InputBox("请输入删除内容")
Application.ScreenUpdating = False
Dim j As Integer
j = 1
For Each i In ActiveDocument.Paragraphs
    Selection.Find.ClearFormatting
    Selection.Find.Text = n + "^p"
    Selection.Find.MatchWildcards = False
    Selection.Find.Execute
    'Debug.Print j
    Debug.Print Selection.Text
    'Debug.Print InStr(Left(Selection.Text, Len(Selection.Text) - 1), n)
    If InStr(Left(Selection.Text, Len(Selection.Text) - 1), n) > 0 Then
        Selection.HomeKey Unit:=wdLine
        Selection.EndKey Unit:=wdLine, Extend:=wdExtend
        Selection.Delete Unit:=wdCharacter, Count:=1
    End If
    j = j + 1
Next
End Sub