如何遍历SmartArt

ning84

Shape.SmartArt 属性 (Excel) | Microsoft Learn  https://learn.microsoft.com/zh-c ... xcel.shape.smartart

返回一个 对象，该对象表示与形状关联的 SmartArt。 此为只读属性。

1. Sub ll()
   
2.    Dim Pres As Presentation
   
3.        Set Pres = Application.ActivePresentation
   
4.    Dim Sld As Slide, Shp As Shape
   
5.    Dim Ss As SmartArt
   
6.        For Each Sld In Pres.Slides
   
7.             For Each Shp In Sld.Shapes
   
8.                  Debug.Print Shp.Name, Shp.Type
   
9.                  Select Case Shp.Type
   
10.                       Case 24  '"msoIgxGraphic"
    
11.                           Set Ss = Shp.SmartArt
    
12.                           With Ss
    
13.                               Debug.Print .AllNodes.Count
    
14.                               Debug.Print .Application
    
15.                           End With
    
16.                           Stop
    
17.                           Stop
    
18.                  End Select
    
19.             Next Shp
    
20.        Next Sld
    
21. End Sub
    

复制代码

ning84

手动能更改图片，VBA不能更改图片。

1. Sub ll1()
   
2.    Dim oLeft, oTop, oWidth, oHeight
   
3.    Dim Pres As Presentation
   
4.        Set Pres = Application.ActivePresentation
   
5.    Dim Sld As Slide, Shp As Shape
   
6.        Set Sld = Pres.Slides(1)
   
7.        Set Shp = Sld.Shapes("Pic")
   
8.        With Shp
   
9.             oLeft = .Left
   
10.             oTop = .Top
    
11.             oWidth = .Width
    
12.             oHeight = .Height
    
13.        End With
    
14.        Debug.Print Shp.Name
    
15.        Shp.Delete
    
16.        FileName = "F:\6.jpg"
    
17.        Set Shp = Sld.Shapes.AddPicture(FileName, msoCTrue, 0, oLeft, oTop, oWidth, oHeight)
    
18.        With Shp
    
19.             .Name = "Pic"
    
20.             .AutoShapeType = msoShapeSquareTabs
    
21.        End With
    
22. 
    
23. End Sub
    

复制代码

ning84

顶层msoBringToFront和底层msoSendBackward

1. Sub del()
   
2.    Dim Pres As Presentation
   
3.    Dim Sld As Slide
   
4.    Dim Shp As Shape
   
5.        Set Pres = Application.ActivePresentation
   
6.        For ii = 1 To Pres.Slides.Count
   
7.            Set Sld = Pres.Slides(ii)
   
8.            Set Shp = Sld.Shapes("oPicture")
   
9.            'Shp.ZOrder msoBringForward
   
10.            Shp.ZOrder msoBringToFront
    
11.            'Shp.ZOrder msoSendBackward
    
12.            Debug.Print Sld.Name, Shp.Name
    
13.        Next ii
    
14. End Sub
    

复制代码

ning84

Sld.SlideIndex 和 Pres.Slides.Count 的应用。

1. Sub del()
   
2.    Dim Pres As Presentation
   
3.    Dim Sld As Slide
   
4.    Dim Shp As Shape
   
5.    Dim oTable As Table
   
6.    Dim Str, Aa
   
7.        Set Pres = Application.ActivePresentation
   
8.        For ii = 2 To Pres.Slides.Count
   
9.           Set Sld = Pres.Slides(ii)
   
10.           Set oTable = Sld.Shapes("oTable").Table
    
11.           Str = oTable.Cell(2, 3).Shape.TextFrame.TextRange.Text
    
12.           Aa = Split(Str, " ")
    
13.          
    
14.           Str = Aa(0) & " (第" & Sld.SlideIndex - 1 & "张/共" & Pres.Slides.Count & "张)"
    
15.           oTable.Cell(2, 3).Shape.TextFrame.TextRange.Text = Str
    
16.               Debug.Print Sld.SlideNumber, Sld.SlideIndex, oTable.Cell(2, 3).Shape.TextFrame.TextRange.Text
    
17.          
    
18.        Next ii
    
19. 
    
20. End Sub
    

复制代码

ning84

遍历表格Table和文本TextRange

1. Private Sub d()
   
2.    Dim Pres As Presentation
   
3.        Set Pres = Application.ActivePresentation
   
4.    Dim Shp As Shape, Str
   
5.    Dim oTable As Table
   
6.    Dim TxtRng As TextRange
   
7.       For ii = 2 To Pres.Slides.Count
   
8.          Set oTable = Pres.Slides(ii).Shapes("oTable").Table
   
9.          With oTable
   
10.             For kk = 0 To .Rows.Count - 2
    
11.                 .Rows(kk + 1).Height = 20
    
12.                 'Debug.Print Pres.Slides(ii).Name, .Cell(kk + 1, 1).Shape.Height
    
13.             Next kk
    
14.             
    
15.             Str = .Cell(1, 2).Shape.TextFrame.TextRange.Text
    
16.             Debug.Print Str,
    
17.          End With
    
18.          Set Shp = Pres.Slides(ii).Shapes("oTitle")
    
19.    
    
20.          Set TxtRng = Shp.TextFrame.TextRange
    
21.          Debug.Print TxtRng.Font.Size,
    
22.          TxtRng.Font.Size = 28
    
23.          Shp.Top = 30
    
24.         
    
25.          Debug.Print Shp.Top
    
26.          
    
27.       Next ii
    
28.       
    
29. End Sub

复制代码

ning84

1. Sub ll()
   
2.    Dim MsoArr(138)
   
3.    Dim Hh
   
4.           MsoArr(0) = msoShapeFlowchartConnector
   
5.           MsoArr(1) = msoShapeFlowchartData
   
6.           MsoArr(2) = msoShapeFlowchartDecision
   
7.           MsoArr(3) = msoShapeFlowchartDelay
   
8.           MsoArr(4) = msoShapeFlowchartDirectAccessStorage
   
9.           MsoArr(5) = msoShapeFlowchartDisplay
   
10.           MsoArr(6) = msoShapeFlowchartDocument
    
11.           MsoArr(7) = msoShapeFlowchartExtract
    
12.           MsoArr(8) = msoShapeFlowchartInternalStorage
    
13.           MsoArr(9) = msoShapeFlowchartMagneticDisk
    
14.           MsoArr(10) = msoShapeFlowchartManualInput
    
15.           MsoArr(11) = msoShapeFlowchartManualOperation
    
16.           MsoArr(12) = msoShapeFlowchartMerge
    
17.           MsoArr(13) = msoShapeFlowchartMultidocument
    
18.           MsoArr(14) = msoShapeFlowchartOffpageConnector
    
19.           MsoArr(15) = msoShapeFlowchartOr
    
20.           MsoArr(16) = msoShapeFlowchartPredefinedProcess
    
21.           MsoArr(17) = msoShapeFlowchartPreparation
    
22.           MsoArr(18) = msoShapeFlowchartProcess
    
23.           MsoArr(19) = msoShapeFlowchartPunchedTape
    
24.           MsoArr(20) = msoShapeFlowchartSequentialAccessStorage
    
25.           MsoArr(21) = msoShapeFlowchartSort
    
26.           MsoArr(22) = msoShapeFlowchartStoredData
    
27.           MsoArr(23) = msoShapeFlowchartSummingJunction
    
28.           MsoArr(24) = msoShapeFlowchartTerminator
    
29.           MsoArr(25) = msoShapeFoldedCorner
    
30.           MsoArr(26) = msoShapeHeart
    
31.           MsoArr(27) = msoShapeHexagon
    
32.           MsoArr(28) = msoShapeHorizontalScroll
    
33.           MsoArr(29) = msoShapeIsoscelesTriangle
    
34.           MsoArr(30) = msoShapeLeftArrow
    
35.           MsoArr(31) = msoShapeLeftArrowCallout
    
36.           MsoArr(32) = msoShapeLeftBrace
    
37.           MsoArr(33) = msoShapeLeftBracket
    
38.           MsoArr(34) = msoShapeLeftRightArrow
    
39.           MsoArr(35) = msoShapeLeftRightArrowCallout
    
40.           MsoArr(36) = msoShapeLeftRightUpArrow
    
41.           MsoArr(37) = msoShapeLeftUpArrow
    
42.           MsoArr(38) = msoShapeLightningBolt
    
43.           MsoArr(39) = msoShapeLineCallout1
    
44.           MsoArr(40) = msoShapeLineCallout1AccentBar
    
45.           MsoArr(41) = msoShapeLineCallout1BorderandAccentBar
    
46.           MsoArr(42) = msoShapeLineCallout1NoBorder
    
47.           MsoArr(43) = msoShapeLineCallout2
    
48.           MsoArr(44) = msoShapeLineCallout2AccentBar
    
49.           MsoArr(45) = msoShapeLineCallout2BorderandAccentBar
    
50.           MsoArr(46) = msoShapeLineCallout2NoBorder
    
51.           MsoArr(47) = msoShapeLineCallout3
    
52.           MsoArr(48) = msoShapeLineCallout3AccentBar
    
53.           MsoArr(49) = msoShapeLineCallout3BorderandAccentBar
    
54.           MsoArr(50) = msoShapeLineCallout3NoBorder
    
55.           MsoArr(51) = msoShapeLineCallout4
    
56.           MsoArr(52) = msoShapeLineCallout4AccentBar
    
57.           MsoArr(53) = msoShapeLineCallout4BorderandAccentBar
    
58.           MsoArr(54) = msoShapeLineCallout4NoBorder
    
59.           'MsoArr(55) = msoShapeMixed
    
60.           MsoArr(56) = msoShapeMoon
    
61.           MsoArr(57) = msoShapeNoSymbol
    
62.           MsoArr(58) = msoShapeNotchedRightArrow
    
63.           'MsoArr(59) = msoShapeNotPrimitive
    
64.           MsoArr(60) = msoShapeOctagon
    
65.           MsoArr(61) = msoShapeOval
    
66.           MsoArr(62) = msoShapeOvalCallout
    
67.           MsoArr(63) = msoShapeParallelogram
    
68.           MsoArr(64) = msoShapePentagon
    
69.           MsoArr(65) = msoShapePlaque
    
70.           MsoArr(66) = msoShapeQuadArrow
    
71.           MsoArr(67) = msoShapeQuadArrowCallout
    
72.           MsoArr(68) = msoShapeRectangle
    
73.           MsoArr(69) = msoShapeRectangularCallout
    
74.           MsoArr(70) = msoShapeRegularPentagon
    
75.           MsoArr(71) = msoShapeRightArrow
    
76.           MsoArr(72) = msoShapeRightArrowCallout
    
77.           MsoArr(73) = msoShapeRightBrace
    
78.           MsoArr(74) = msoShapeRightBracket
    
79.           MsoArr(75) = msoShapeRightTriangle
    
80.           MsoArr(76) = msoShapeRoundedRectangle
    
81.           MsoArr(77) = msoShapeRoundedRectangularCallout
    
82.           MsoArr(78) = msoShapeSmileyFace
    
83.           MsoArr(79) = msoShapeStripedRightArrow
    
84.           MsoArr(80) = msoShapeSun
    
85.           MsoArr(81) = msoShapeTrapezoid
    
86.           MsoArr(82) = msoShapeUpArrow
    
87.           MsoArr(83) = msoShapeUpArrowCallout
    
88.           MsoArr(84) = msoShapeUpDownArrow
    
89.           MsoArr(85) = msoShapeUpDownArrowCallout
    
90.           MsoArr(86) = msoShapeUpRibbon
    
91.           MsoArr(87) = msoShapeUTurnArrow
    
92.           MsoArr(88) = msoShapeVerticalScroll
    
93.           MsoArr(89) = msoShapeWave
    
94.           MsoArr(90) = msoShapeFlowchartCollate
    
95.           MsoArr(91) = msoShape16pointStar
    
96.           MsoArr(92) = msoShape24pointStar
    
97.           MsoArr(93) = msoShape32pointStar
    
98.           MsoArr(94) = msoShape4pointStar
    
99.           MsoArr(95) = msoShape5pointStar
    
100.           MsoArr(96) = msoShape8pointStar
     
101.           MsoArr(97) = msoShapeActionButtonBackorPrevious
     
102.           MsoArr(98) = msoShapeActionButtonBeginning
     
103.           MsoArr(99) = msoShapeActionButtonCustom
     
104.           MsoArr(100) = msoShapeActionButtonDocument
     
105.           MsoArr(101) = msoShapeActionButtonEnd
     
106.           MsoArr(102) = msoShapeActionButtonForwardorNext
     
107.           MsoArr(103) = msoShapeActionButtonHelp
     
108.           MsoArr(104) = msoShapeActionButtonHome
     
109.           MsoArr(105) = msoShapeActionButtonInformation
     
110.           MsoArr(106) = msoShapeActionButtonMovie
     
111.           MsoArr(107) = msoShapeActionButtonReturn
     
112.           MsoArr(108) = msoShapeActionButtonSound
     
113.           MsoArr(109) = msoShapeArc
     
114.           MsoArr(110) = msoShapeBalloon
     
115.           MsoArr(111) = msoShapeBentArrow
     
116.           MsoArr(112) = msoShapeBentUpArrow
     
117.           MsoArr(113) = msoShapeBevel
     
118.           MsoArr(114) = msoShapeBlockArc
     
119.           MsoArr(115) = msoShapeCan
     
120.           MsoArr(116) = msoShapeChevron
     
121.           MsoArr(117) = msoShapeCircularArrow
     
122.           MsoArr(118) = msoShapeCloudCallout
     
123.           MsoArr(119) = msoShapeCross
     
124.           MsoArr(120) = msoShapeCube
     
125.           MsoArr(121) = msoShapeCurvedDownArrow
     
126.           MsoArr(122) = msoShapeCurvedDownRibbon
     
127.           MsoArr(123) = msoShapeCurvedLeftArrow
     
128.           MsoArr(124) = msoShapeCurvedRightArrow
     
129.           MsoArr(125) = msoShapeCurvedUpArrow
     
130.           MsoArr(126) = msoShapeCurvedUpRibbon
     
131.           MsoArr(127) = msoShapeDiamond
     
132.           MsoArr(128) = msoShapeDonut
     
133.           MsoArr(129) = msoShapeDoubleBrace
     
134.           MsoArr(130) = msoShapeDoubleBracket
     
135.           MsoArr(131) = msoShapeDoubleWave
     
136.           MsoArr(132) = msoShapeDownArrow
     
137.           MsoArr(133) = msoShapeDownArrowCallout
     
138.           MsoArr(134) = msoShapeDownRibbon
     
139.           MsoArr(135) = msoShapeExplosion1
     
140.           MsoArr(136) = msoShapeExplosion2
     
141.           MsoArr(137) = msoShapeFlowchartAlternateProcess
     
142.           MsoArr(138) = msoShapeFlowchartCard
     
143.       Dim Shp As Shape, oShp As Shape, Str
     
144. Debug.Print TypeName(MsoArr(55))
     
145. 
     
146. 
     
147.           Set Shp = Sheet1.Shapes(1)
     
148.           Hh = Shp.Top
     
149.           ''
     
150.           For ii = 0 To 138
     
151.                Shp.Duplicate
     
152.                Set oShp = Sheet1.Shapes(ii)
     
153.                If MsoArr(ii) <> Empty Then
     
154.                oShp.AutoShapeType = MsoArr(ii)
     
155.                
     
156.                Hh = Hh + 100
     
157.                oShp.Top = Hh
     
158.                Str = "MsoArr(" & ii & ")=" & MsoArr(ii)
     
159.                
     
160.                oShp.TextFrame2.TextRange.Text = MsoArr(ii) & Str
     
161.                End If
     
162.                
     
163.           Next ii
     
164. 
     
165. 
     
166. End Sub

复制代码