从excel,在vba中,获取在powerpoint中选择的当前形状的Id

时间:2016-06-28 08:38:25

标签: excel vba excel-vba powerpoint

我在excel工作,我在vba中的一个目录循环中打开几个powerpoint。 当我运行宏(来自excel)时,我在powerpoints演示文稿中的每张幻灯片中的每个形状中都进行了循环。

我停止宏以查看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

1 个答案:

答案 0 :(得分:0)

    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