[求助]如何删除word中的固定大小的所有图片，用vba删除。

守柔

QUOTE:

以下是引用downbaidu在2008-2-26 22:25:11的发言：

删除excel中所有工作簿中的图片和文字！

我要把里面的图片全部删除，有三个工作表。里面有三个图片，和三个文字。

现在要把里面的三个图片全部删除，还有文字也删除，文字是（下载摆渡）

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2008-2-27 6:39:19
'仅测试于System: Windows NT Excel: 11.0 Language: 2052
'№ 0341^The Code CopyIn [ThisWorkbook- ThisWorkbook]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit
Sub Example()
    Dim oSheet As Worksheet, oShape As Shape
    Dim myHeight As Single, myWidth As Single
    Dim DelString As String
    DelString = "下载摆渡"
    myHeight = 30   '磅,必须以磅为单位,如以厘米等,则会在单位换算过程中出现误差
    myWidth = 450.75    '磅
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '如 以磅为单位返回sheets(1)需要删除的图形(图形1)的宽或者高
    '     MsgBox Sheets(1).Shapes(1).Width
    '     MsgBox Sheets(1).Shapes(1).Heigth
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Application.ScreenUpdating = False
    For Each oSheet In ActiveWorkbook.Sheets
        '删除指定宽度高度的浮动式图形
        For Each oShape In oSheet.Shapes
            If oShape.Height = myHeight And oShape.Width = myWidth Then oShape.Delete
        Next
        '删除指定文本
        oSheet.Cells.Replace What:=DelString, Replacement:=""
    Next
    Application.ScreenUpdating = True
End Sub
'----------------------

downbaidu

QUOTE:

以下是引用守柔在2008-2-27 6:28:23的发言：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2008-2-27 6:27:58
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0339^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit

Sub Example()
    Dim oInlineShape As InlineShape, oShape As Shape
    Dim myHeight As Single, myWidth As Single
    myHeight = 23    '磅,必须以磅为单位,如以厘米等,则会在单位换算过程中出现误差
    myWidth = 415    '磅
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '如
   以磅为单位返回需要删除的图形的宽或者高
    '    MsgBox Selection.ShapeRange(1).Width
    '    MsgBox Selection.ShapeRange(1).Height
    '    MsgBox Selection.InlineShapes(1).Width
    '    MsgBox Selection.InlineShapes(1).Height
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Application.ScreenUpdating = False
    '删除指定高度宽度的嵌入式图形
    For Each oInlineShape In ActiveDocument.InlineShapes
        If oInlineShape.Height = myHeight And oInlineShape.Width = myWidth Then oInlineShape.Delete
    Next
    '删除指定宽度高度的浮动式图形
    For Each oShape In ActiveDocument.Shapes
        If oShape.Height = myHeight And oShape.Width = myWidth Then oShape.Delete
    Next
    Application.ScreenUpdating = True
End Sub
'----------------------

有错误提示

守柔

QUOTE:

以下是引用守柔在2008-2-27 6:40:32的发言：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2008-2-27 6:39:19
'仅测试于System: Windows NT Excel: 11.0 Language: 2052

'№ 0341^The Code CopyIn [ThisWorkbook- ThisWorkbook]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

除了等待之外,楼主其实可以看一下代码头的.

你的图形在EXCEL工作薄中,宏代码自然在EXCEL的工作薄之中,怎么会在WORD中呢?

除非必须通过Word控制EXCEL是另当别论了.

downbaidu

版主教训的是，谢谢了！

还有就是PPT的可以帮忙再看下吗？

downbaidu

QUOTE:

以下是引用downbaidu在2008-2-26 22:21:29的发言：

删除PPT幻灯片中固定大小的图片！

有三个幻灯片想一次删除里面的所有图片。

谢谢了。呵呵。

这是PPT的问题。

守柔

QUOTE:

以下是引用downbaidu在2008-2-27 22:19:37的发言：

这是PPT的问题。

请将以下代码复制于活动PPT文档的标准模块代码窗口中(见附件)

Option Explicit

Sub Example()
    Dim oSlide As Slide, oShape As Shape
    Dim myWidth As Single, myHeight As Single
    myWidth = 527.25
    myHeight = 35
    For Each oSlide In ActivePresentation.Slides
        For Each oShape In oSlide.Shapes
            If oShape.Type = msoPicture Then
                If oShape.Width = myWidth And oShape.Height = myHeight Then
                    oShape.Delete
                End If
            End If
        Next
    Next
End Sub

jjgyioSK.rar (13.8 KB, 下载次数: 192)

2008-2-28 06:17 上传

点击文件名下载附件
[求助]如何删除word中的固定大小的所有图片，用vba删除。

downbaidu

QUOTE:

以下是引用downbaidu在2008-2-26 11:30:05的发言：
还有如何删除doc中设置了不同的页眉页脚，如何一次全部删除，或全部修改呢？

设置了首页页眉页脚，奇数页页眉页脚和偶数页页眉页脚，如何一次删除里面的文字和固定大小的图片呢？

谢谢了！

RLPyQeuS.rar (9.59 KB, 下载次数: 23)

2008-2-28 14:18 上传

点击文件名下载附件
[求助]如何删除word中的固定大小的所有图片，用vba删除。

守柔

QUOTE:

以下是引用downbaidu在2008-2-28 14:18:31的发言：

设置了首页页眉页脚，奇数页页眉页脚和偶数页页眉页脚，如何一次删除里面的文字和固定大小的图片呢？

谢谢了！

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2008-2-28 17:59:42
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0343^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit
Sub Example()
'不管三七二十一，统统删除
    Dim oSection As Section, i As Byte, myRange As Range
    For Each oSection In ActiveDocument.Sections
        For i = 1 To 3
            Set myRange = oSection.Headers(i).Range
            myRange.Delete
            myRange.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
        Next
        For i = 1 To 3
            Set myRange = oSection.Footers(i).Range
            myRange.Delete
        Next
    Next
End Sub
'----------------------
Sub Example2()
'删除文字和指定大小的图片
    Dim oSection As Section, i As Byte, myRange As Range
    Dim oInlineShape As InlineShape, oShape As Shape
    Dim myWidth As Single, myHeight As Single
    myWidth = 414.75
    myHeight = 27.75
    For Each oSection In ActiveDocument.Sections
        For i = 1 To 3
            Set myRange = oSection.Headers(i).Range
            For Each oInlineShape In myRange.InlineShapes
                If oInlineShape.Height = myHeight And oInlineShape.Width = myWidth Then oInlineShape.Delete
            Next
            For Each oShape In ActiveDocument.Shapes
                If oShape.Height = myHeight And oShape.Width = myWidth Then oShape.Delete
            Next
            myRange.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
            With myRange.Find
                .ClearFormatting
                .Text = "[!^1]@"
                .MatchWildcards = True
                .Replacement.Text = ""
                .Execute Replace:=wdReplaceAll
            End With
        Next
        For i = 1 To 3
            Set myRange = oSection.Footers(i).Range
            For Each oInlineShape In myRange.InlineShapes
                If oInlineShape.Height = myHeight And oInlineShape.Width = myWidth Then oInlineShape.Delete
            Next
            For Each oShape In ActiveDocument.Shapes
                If oShape.Height = myHeight And oShape.Width = myWidth Then oShape.Delete
            Next
            myRange.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
            With myRange.Find
                .ClearFormatting
                .Text = "[!^1]@"
                .MatchWildcards = True
                .Replacement.Text = ""
                .Execute Replace:=wdReplaceAll
            End With
        Next
    Next
End Sub
'----------------------

downbaidu

再问个问题，如何用宏设置保护文档，并设置密码。设置成这样的。

保护文档后不能修改，修改需要输入密码的。这个的密码是：123

 

守柔

QUOTE:

以下是引用downbaidu在2008-2-28 21:55:28的发言：

再问个问题，如何用宏设置保护文档，并设置密码。设置成这样的。

保护文档后不能修改，修改需要输入密码的。这个的密码是：123

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2008-2-29 6:39:07
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0344^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit

Sub Example()
'注意,如果文档已保护,再保护文档时会出错,请按以下代码如实设置
'即先判断文档是否保护,再作决定
    Dim strPW As String
    strPW = "123"
    If ActiveDocument.ProtectionType = wdNoProtection Then
        ActiveDocument.Protect wdAllowOnlyFormFields, True, strPW
        '仅允许在文档中作此类编辑
        'wdAllowOnlyComments'批注
        'wdAllowOnlyFormFields'填写窗体域
        'wdAllowOnlyReading'未作任何更改(只读)
        'wdAllowOnlyRevisions'修订
    Else
        ActiveDocument.Unprotect strPW    '取消保护文档
        '此处可用代码进行文档编辑
        '编辑完成后再进行文档保护
    End If
End Sub
'----------------------