删除图形（宏）——更新 2022.11.30

413191246se

* 图片（InlineShapes）：不包含文字，全部删除（如果包含文字，将变得复杂了，要 OCR 识别，此处不谈）。
* 图形（包含文本框）（Shapes）：有的不含文字，有的含有文字，根据 .HasText 属性提取后默认粘贴到文首，我将其剪切到文尾，放在六个星号“*”后面。
* 图文框（Frames）：可能由文本框转换而来，也可能由表格（文字环绕）转换而来。删除后会自动提取文字到所在段落的前面或后面。
      
* 不知各位朋友们有何高见？请探讨及赐教，谢谢大家！
     
* 请试用最新更新的代码《删除图形》宏：（示例文档请自行建立）

1. Sub a1130_DeleteShapes()
   
2. '删除图形
   
3. '红色文字提取自图文框/六个星号"*"后面文字提取自文本框/表格环绕将变成图文框
   
4. 
   
5.     Dim r As Range, t As Table, iShape As InlineShape, Frm As Frame, n&, m&
   
6. 
   
7.     With ActiveDocument
   
8.         If .Shapes.Count <> 0 Then .Content.InsertParagraphBefore: m = 1
   
9. 
   
10.         Set r = .Paragraphs(1).Range
    
11. 
    
12.         '表格取消文字环绕
    
13.         For Each t In .Tables
    
14.             t.Range.Rows.WrapAroundText = False
    
15.         Next
    
16. 
    
17.         '删除图片(InlineShape)
    
18.         For Each iShape In .InlineShapes
    
19.             iShape.Delete
    
20.         Next
    
21. 
    
22.         '删除图形(Shape)/文本框
    
23.         For n = .Shapes.Count To 1 Step -1
    
24.             With .Shapes(n)
    
25.                 If .TextFrame.HasText <> 0 Then r.InsertBefore Text:=.TextFrame.TextRange.Text
    
26.                 .Delete
    
27.             End With
    
28.         Next
    
29. 
    
30.         '删除图文框(Frame)
    
31.         For Each Frm In .Frames
    
32.             With Frm
    
33.                 .Select
    
34.                 .Delete
    
35.                 Selection.ClearFormatting
    
36.                 Selection.Font.Color = wdColorRed
    
37.             End With
    
38.         Next
    
39. 
    
40.         If m = 1 Then .Content.InsertAfter Text:=vbCr & "******" & vbCr & r.Text: r.Delete
    
41.     End With
    
42. 
    
43.     Selection.HomeKey 6
    
44.     DocInfo
    
45. End Sub
    
46. 
    
47. Sub DocInfo()
    
48.     With ActiveDocument
    
49.         MsgBox "页数/Pages = " & .ComputeStatistics(wdStatisticPages) & vbCr & _
    
50.             "字数/Characters = " & .ComputeStatistics(wdStatisticCharacters) & vbCr & vbCr & _
    
51.             "分节/Sections = " & .Sections.Count & vbCr & _
    
52.             "表格/Tables = " & .Tables.Count & vbCr & vbCr & _
    
53.             "图片/InlineShapes = " & .InlineShapes.Count & vbCr & _
    
54.             "图形/文本框/Shapes = " & .Shapes.Count & vbCr & _
    
55.             "图文框/Frames = " & .Frames.Count, 0 + 48, "文档信息"
    
56.     End With
    
57. End Sub

复制代码

413191246se

经过探索，VBA 的确能使部分文本框转换为图文框！但尚有很多文本框不能转换为图文框，所以，文本框转换为图文框没有太大意义。

413191246se

此帖已更新。