从excel中，在vba中，获取在powerpoint中选择的当前形状的标识

Question

我从excel中工作，并且我在一个目录中的循环中打开几个powerpoint，以vba的形式。 虽然我运行宏（来自excel），但我在powerpoint演示文稿中的每个幻灯片内的每个形状内都会制作一个循环。

我停止宏以查看AutoShapeType = -2，并且我在vba中选择它只是为了检查形象是否是我想要的形状。 否则，如果选定的形状看起来不正确，我会手动选择它，并且我想知道如何获取当前选定形状的id，以命名它。

Set PPtapp = CreateObject("Powerpoint.Application") 
PPtapp.Visible = True 
Dim sld As Slide 
Dim numslide As Long 
Dim nbslide As Long 
Dim WVL_CptShape As Integer 

'list of every powerpoint path 
ppt = ThisWorkbook.Worksheets("Template").Range("A" & i).Value 

For i = 2 To ThisWorkbook.Worksheets("Template").Range("A65536").End(xlUp).Row + 1 
    Set PptDoc = PPtapp.Presentations.Open(ppt) 
    With PptDoc 
     For Each sld In PptDoc.Slides 
      For WVL_CptShape = 1 To .Slides(sld.SlideNumber).Shapes.Count 
       WVL_Id = .Slides(sld.SlideNumber).Shapes(WVL_CptShape).ID 
       If PptDoc.Slides(sld.SlideNumber).Shapes(WVL_CptShape).AutoShapeType = -2 Then 
        'I select the shape to see visualy if it's a good selection and I stop the macro 
        PptDoc.Slides(sld.SlideNumber).Shapes(WVL_CptShape).Select 
        Stop 
        'if the selection doesnt seems right I select the right shape manualy 
        'Question : in vba, i want to change the name of the selected shape. 
        'But i don't know how to get the id of the current selected shape (see below : ID_OF_CURRENT_SHAPE_SELECTED_MANUALY) 
        'I would like to rename it, in order to recognize it easily next time 
        PptDoc.Slides(sld.SlideNumber). Shapes(ID_OF_CURRENT_SHAPE_SELECTED_MANUALY).Selection.Name = "Myshape" 
       end if 
      Next WVL_CptShapeNext 
     sld.Close 
    End With 
Next 
PPtapp.Quit 
Set PPtapp = Nothing 

Answer 1

Set PptDoc = PPtapp.Presentations.Open(ppt) 
    With PptDoc 
     For Each sld In PptDoc.Slides 
      For WVL_CptShape = 1 To sld.Shapes.Count 
       WVL_Id = sld.Shapes(WVL_CptShape).ID 
       If sld.Shapes(WVL_CptShape).AutoShapeType = -2 Then 
        'I select the shape to see visualy if it's a good selection and I stop the macro 
        sld.Shapes(WVL_CptShape).Select 
        Stop 

' And to change the name of the shape: 
sld.Shapes(WVL_CptShape).Name = "New name for shape" 
' or better, in case you selected a different shape: 

ActiveWindow.Selection.ShapeRange（1）请将.Name = “为造型的新名称”

在这种类型的情况下，要与形状的指数，而不是它的ID工作。

请注意，您可以遍历幻灯片中的形状集合，就像您可以遍历演示文稿中的幻灯片集合一样。它使代码更容易编写和遵循：

Set PptDoc = PPtapp.Presentations.Open(ppt) 
With PptDoc 
    For Each sld In PptDoc.Slides 
     For each shp in sld.shapes 
      If shp.AutoShapeType = -2 Then 
       'I select the shape to see visualy if it's a good selection and I stop the macro 
       shp.Select 
       Stop