.SlideOrientation = msoOrientationHorizontal

ning84

1. Sub ll()
   
2.    Dim Pres As Presentation
   
3.        Set Pres = Application.ActivePresentation
   
4.        With Pres.PageSetup
   
5.            Debug.Print .SlideOrientation
   
6.            .SlideOrientation = msoOrientationVertical
   
7.            Debug.Print .SlideWidth, .SlideHeight, .SlideSize
   
8.            .SlideOrientation = msoOrientationHorizontal
   
9.            Debug.Print .SlideWidth, .SlideHeight, .SlideSize
   
10.            
    
11.        End With
    
12. End Sub
    

复制代码

result

2
540           720
720           540

ning84

1. Sub ll()
   
2.    Dim ShpRng As ShapeRange
   
3.    Dim Sld As Slide
   
4.    Dim Shp As Shape, Shps As Shapes
   
5.        Set Sld = Application.ActivePresentation.Slides(1)
   
6.        Set Shps = Sld.Shapes
   
7.        Set ShpRng = Application.ActiveWindow.Selection.ShapeRange
   
8.        Set Shp = Shps(ShpRng.Name)
   
9.        Stop
   
10.       
    
11.        Debug.Print ShpRng.Name
    
12.        With Shp
    
13.             Debug.Print .Name, .AutoShapeType
    
14.             .AutoShapeType = msoShape10pointStar
    
15.             .Fill.BackColor.ObjectThemeColor = msoThemeColorText1
    
16.             'ShpRng.Glow.Color.ObjectThemeColor = msoThemeColorAccent3
    
17.        End With
    
18. End Sub
    

复制代码

1. '''
   
2. Sub ColumnFToNotePageShapes2()
   
3.      Dim Str
   
4.      Dim Fso As FileSystemObject, oFile As File
   
5.          Set Fso = New FileSystemObject
   
6.      Dim MenuSht As Worksheet, Sht As Worksheet, oSht As Worksheet
   
7.      Dim Rng As Range, MenuRng As Range
   
8.          Set Rng = Selection.CurrentRegion
   
9.          Set Sht = Rng.Parent
   
10.          Debug.Print Rng.Address
    
11.      Dim Shp2  'As Shape
    
12.      Dim Shp3 ' As Shape
    
13.      Dim PathName
    
14.          PathName = ThisWorkbook.Path & "" & Sht.Name & ".Pptx"
    
15.      Dim Pres As Presentation
    
16.          Set Pres = OpenPpt(Fso, PathName)
    
17.          
    
18.      Dim Sld As Slide, Slds As Slides
    
19.          Set Slds = Pres.Slides
    
20.      Dim PicShp, Shp ' As Shape
    
21.      Dim ShpRng  'As ShapeRange
    
22.      Dim TxtArr(2)
    
23.          For ii = 1 To Rng.Rows.Count - 1
    
24.                  Str = Sht.Cells(Rng(ii, 1).Row, "B")
    
25.                  Set Sld = Slds(ii) '(Str)
    
26.                  'Sld.NotesPage.Shapes(2).TextFrame2.TextRange.Text = Sht.Cells(Rng(ii, 1).Row, "F") & Chr(10) & "#"
    
27.                  TxtArr(0) = Sht.Cells(Rng(ii, 1).Row, "D")
    
28.                  TxtArr(1) = Sht.Cells(Rng(ii, 1).Row, "E")
    
29.                  TxtArr(2) = Sht.Cells(Rng(ii, 1).Row, "F")
    
30.                  Txt1Txt2Txt3 Sld.Shapes, TxtArr
    
31.          Next ii
    
32.      
    
33. Beep
    
34. End Sub
    
35. 
    
36. 
    
37. Function Txt1Txt2Txt3(Shps, TxtArr)
    
38.   Dim S As Shapes
    
39.       
    
40.   Dim Shp 'As Shape
    
41.   Dim ShpRng 'As ShapeRange
    
42.   Dim Arr(2)
    
43.       Arr(0) = Array("Txt1", 5, 5, 700, 30, msoShapeChevron, msoThemeColorAccent6, 12, ppAutoSizeShapeToFitText, msoFalse)
    
44.       Arr(1) = Array("Txt2", 410, 25, 285, 490, 0, 0, 16, 0, 0)
    
45.       Arr(2) = Array("Txt3", 275, 465, 345, 75, msoShapePlaque, msoThemeColorAccent1, 18, ppAutoSizeShapeToFitText, msoFalse)
    
46. 
    
47.      For ii = Shps.Count To 2 Step -1
    
48.           Set Shp = Shps(ii)
    
49.           Shp.Delete
    
50.      Next ii
    
51.      For ii = 0 To 2
    
52.          Set Shp = Shps.AddLabel(msoTextOrientationHorizontal, 0, 0, 100, 50)
    
53.          Shp.Name = Arr(ii)(0)
    
54.          Set Shp = Shps(Arr(ii)(0))
    
55.          ''
    
56.          With Shp
    
57.              .TextFrame2.TextRange.Text = TxtArr(ii) 'Arr(ii)(0)
    
58.              .Name = Arr(ii)(0)
    
59.              .Left = Arr(ii)(1)
    
60.              .Top = Arr(ii)(2)
    
61.              .Width = Arr(ii)(3)
    
62.              .Height = Arr(ii)(4)
    
63.              'Debug.Print .Left, ","; .Top, ",", .Width, ","; .Height
    
64.              If Arr(ii)(5) <> 0 Then
    
65.                  .AutoShapeType = Arr(ii)(5)
    
66.                  .Fill.BackColor.ObjectThemeColor = Arr(ii)(6)
    
67.                  .TextFrame2.TextRange.Font.Size = Arr(ii)(7)
    
68.                  .TextFrame.AutoSize = Arr(ii)(8)
    
69.                  .TextFrame.WordWrap = Arr(ii)(9)
    
70.              End If
    
71.              .TextFrame.AutoSize = ppAutoSizeShapeToFitText
    
72.          End With
    
73.      Next ii
    
74.   
    
75. End Function
    

复制代码