word中如何用VBA将插入到表格中的图片进行旋转？

eject2010

由于是插入到表格中的照片，采用的是InlineShapes，该如何让它进行旋转90°的命令？

Sub 固定()

Dim n '图片个数

Dim a, b

On Error Resume Next '忽略错误

For n = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes 类型 图片

a = ActiveDocument.InlineShapes(n).Height

b = ActiveDocument.InlineShapes(n).Width

If a > b Then

ActiveDocument.InlineShapes(n).Height = 11 * 28.35 '设置图片高度（1cm等于28.35px）

Else

'这里需要将图片进行旋转后再调整宽度为11cm


ActiveDocument.InlineShapes(n).Width = 11 * 28.35 '设置图片宽度

End If

Next n

End Sub

ming0018

有人做过，找找应该能找到。

eject2010

ming0018 发表于 2018-8-23 11:56
有人做过，找找应该能找到。

也找过，但是都是shape，搬过来也没法用

dafanshu1

先转为shape，旋转后再转回InlineShapes。

zhanglei1371

前段时间写的一个成品：

1. Sub 图像旋转任意角度()
   
2. On Error Resume Next
   
3.     Static s As Integer, rg As Range
   
4.     Set rg = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range) '经典选择语句！！！
   
5.     If Selection.Type = wdSelectionIP Then If MsgBox("程序将处理文中所有图片，是否继续？", vbYesNo) = vbNo Then Exit Sub
   
6.     s = InputBox("请输入要旋转的角度：", "图像旋转", s)
   
7.     For n = 1 To rg.InlineShapes.Count '还可使用count to 1 step-1和for each
   
8.         With rg.InlineShapes(n).ConvertToShape
   
9.             .Rotation = s
   
10.             s = .Rotation
    
11.             .ConvertToInlineShape
    
12.         End With
    
13.     Next
    
14.     For n = 1 To rg.ShapeRange.Count
    
15.         rg.ShapeRange.LockAspectRatio = msoTrue
    
16.         rg.ShapeRange(n).Rotation = s
    
17.         s = rg.ShapeRange(n).Rotation
    
18.     Next
    
19. End Sub

复制代码

eject2010

4L说的是正确的，后来自己想了下，最终代码如下，虽然shape转inlineshape部分代码有点混乱，但的确这样才能满足我的需求：

1. Sub 图片处理()
   
2. 
   
3. Dim oShape As Variant '定义为变体
   
4. 
   
5. Dim a, b, i, k
   
6. 
   
7. On Error Resume Next '忽略错误
   
8. 
   
9. '**********************将InlineShape转换为shape*****************************
   
10.     For Each oShape In ActiveDocument.InlineShapes
    
11.    
    
12.     oShape.Select
    
13.    
    
14.     Set oShape = oShape.ConvertToShape
    
15.    
    
16.     oShape.WrapFormat.AllowOverlap = False '禁止重叠
    
17.    
    
18.     Next
    
19.    
    
20. '***********************判断图片是否需要处理********************************
    
21.     For i = 1 To ActiveDocument.Shapes.Count
    
22. 
    
23.     ActiveDocument.Shapes(i).Select
    
24.    
    
25.     a = ActiveDocument.Shapes(i).Height
    
26. 
    
27.     b = ActiveDocument.Shapes(i).Width
    
28.    
    
29.       If a > b Then                                 '如果图片是长大于宽的竖立放置状态
    
30.         
    
31.         If ActiveDocument.Shapes(i).Rotation = 0 Then '且图片未经过旋转处理（防止二次更改后重复旋转命令）
    
32.       
    
33.         ActiveDocument.Shapes(i).Height = 11 * 28.35  '那么把图片的高度设置为11厘米
    
34.         
    
35.         Else                                          '如果不是竖立放置（图片已经旋转过了成水平放置了）
    
36.         
    
37.         ActiveDocument.Shapes(i).IncrementRotation 90 '那么把图片顺时针旋转90°
    
38.         
    
39.         ActiveDocument.Shapes(i).Height = 11 * 28.35  '同时把图片高度设置为11厘米
    
40.         
    
41.         End If                                        '结束图片是长大于宽这种假设
    
42.         
    
43.         Else                                          '如果图片是款大于长的水平放置状态
    
44.         
    
45.         If ActiveDocument.Shapes(i).Rotation = 0 Then '且图片未经过旋转处理（防止二次更改后重复旋转命令）
    
46.    
    
47.         ActiveDocument.Shapes(i).IncrementRotation -90 '那么把图片逆时针旋转90°
    
48.                
    
49.         ActiveDocument.Shapes(i).Width = 11 * 28.35   '同时把图片宽度设置为11厘米
    
50.         
    
51.         Else                                          '如果不是水平放置（图片已经旋转过了成竖立放置了）
    
52.         
    
53.         ActiveDocument.Shapes(i).Width = 11 * 28.35   '那么把图片宽度设置为11厘米
    
54.               
    
55.         End If                                        '结束图片是宽度大于长度这种假设
    
56.         
    
57.       End If
    
58.    
    
59.    Next
    
60.    
    
61. '**********************将图片重新转换为InlineShape（嵌入式）**************************
    
62. 
    
63. For k = 1 To ActiveDocument.Shapes.Count
    
64. 
    
65. For Each oShape In ActiveDocument.Shapes
    
66. 
    
67. oShape.Select
    
68. 
    
69. oShape.ConvertToInlineShape
    
70. 
    
71. Next oShape
    
72. 
    
73. ActiveDocument.Shapes(k).Select
    
74. 
    
75. ActiveDocument.Shapes(k).ConvertToInlineShape
    
76. 
    
77. oShape.WrapFormat.AllowOverlap = False '禁止重叠
    
78. 
    
79. ActiveDocument.Shapes(k).WrapFormat.AllowOverlap = False
    
80. 
    
81. Next k
    
82. 
    
83. 
    
84. End Sub
    

复制代码

yikaicosm

学习下  谢谢分享  图片方面的处理太繁琐了 有了这个代码方便了很多  谢谢了

Excel2119

eject2010 发表于 2018-8-26 19:24
4L说的是正确的，后来自己想了下，最终代码如下，虽然shape转inlineshape部分代码有点混乱，但的确这样才能 ...

这一版必须得收藏，用的地方可多了，感谢分享