VBA读取指定位置图片大小

w2001pf6604

用VBA如何读取文中[答案]后面公式编辑器编辑的(我认为是图片,不知对不对)的大小,用判断是选择题还是多选题.就是答案后面的ABCD等等的

w2001pf6604

大小指宽度和长度

过客fppt

过客fppt

过客fppt 发表于 2024-8-15 09:44

1. Sub 获取答案后图片长宽判断题型()
   
2.     Dim M
   
3.     With ActiveDocument.Content.Find
   
4.         .text = "【答案】*^p"
   
5.         .MatchWildcards = True
   
6.         Do While .Execute
   
7.             .Parent.Select
   
8.             For Each M In Selection.InlineShapes
   
9.                 M.Select
   
10.                 MsgBox "该图片宽：" & M.Width & "  高：" & M.Height
    
11.                 If M.Width < 14 Then
    
12.                     MsgBox "是单选题"
    
13.                 Else
    
14.                     MsgBox "是多选题"
    
15.                 End If
    
16.             Next
    
17.         Loop
    
18.     End With
    
19. End Sub
    

复制代码

w2001pf6604

过客fppt 发表于 2024-8-15 09:45

非常感谢过客老师!

w2001pf6604

w2001pf6604

运行出了问题

过客fppt

w2001pf6604 发表于 2024-8-15 16:51
运行出了问题

因为我的是WPS，所以段落标记是 ^p，如果不是WPS要改成^13

w2001pf6604

蜀中草莽(83735395)老师的解答
Sub 提取红色答案()
    Set myRange = Selection.Range
    With myRange.Find
        .MatchWildcards = True
        .Text = "【答案】"
        Do While .Execute
            .Parent.Select
            Selection.MoveRight wdCharacter, 1, wdExtend
            If Selection.InlineShapes(1).Type = 1 Then
                If Selection.InlineShapes(1).Width > 12.4 Then
                    Selection.MoveUp 4, 3
                    
                    Selection.InsertBefore "【多选题】" & Chr(13)
                Else
                    Selection.MoveUp 4, 3
                  
                    Selection.InsertBefore "【单选题】" & Chr(13)
                End If
            End If
            .Parent.Collapse wdCollapseEnd
        Loop
    End With

w2001pf6604

蜀中草莽(83735395)老师的解答:
Sub 提取红色答案()
    Set myRange = Selection.Range
    With myRange.Find
        .MatchWildcards = True
        .Text = "【答案】"
        Do While .Execute
            .Parent.Select
            Selection.MoveRight wdCharacter, 1, wdExtend
            If Selection.InlineShapes(1).Type = 1 Then
                If Selection.InlineShapes(1).Width > 12.4 Then
                    Selection.MoveUp 4, 3
                    
                    Selection.InsertBefore "【多选题】" & Chr(13)
                Else
                    Selection.MoveUp 4, 3
                  
                    Selection.InsertBefore "【单选题】" & Chr(13)
                End If
            End If
            .Parent.Collapse wdCollapseEnd
        Loop
    End With