VBA: Значения ячейки Excel, написанные для Ovals в Powerpoint

Question

Я пытаюсь добавить текст в несколько овалов (фигуры, которые уже созданы и расположены) в PowerPoint. Значения читаются из Excel. Также я хотел бы изменить цвет фигур в PowerPoint: если значение> 0, оно должно быть зеленым, а если оно < 0, оно должно быть красным. Я пытаюсь это сделать, но сталкивается с ошибками. Любая помощь будет высоко оценена. я сначала делаю Alt-H, S, L, P и двойной щелчок по именам, чтобы изменить их Oval11, Oval12 и т.д.

Версия: Excel2010, PowerPoint2010

'Code starts 
    Sub AutomateMIS() 
     'Declare variables 
     Dim oPPTApp As PowerPoint.Application 
     Dim oPPTFile As PowerPoint.Presentation 
     Dim oPPTShape As PowerPoint.Shape 
     Dim oPPTSlide As PowerPoint.Slide 
     Dim SlideNum As Integer 

     'Instatntiate Powerpoint and make it visble 
     Set oPPTApp = CreateObject("PowerPoint.Application") 
     oPPTApp.Visible = msoTrue 

     'Opening an existing presentation 
     Set oPPTFile = oPPTApp.Presentations.Open(Filename:=ThisWorkbook.Path & "\" & "MIS.pptx") 

     'Some Code before this 
     SlideNum=1 
     i=3 
     'Update Ovals on next slide 
      Set oPPTShape = oPPTFile.Slides(SlideNum + 1).Shapes("Oval11") 
      oPPTShape.TextFrame.TextRange.Text = c.Offset(, 5).Value 
      Set oPPTShape = oPPTFile.Slides(SlideNum + 1).Shapes("Oval12") 
      oPPTShape.TextFrame.TextRange.Text = c.Offset(, 7).Value 
      Set oPPTShape = oPPTFile.Slides(SlideNum + 1).Shapes("Oval" & (i + 1) & "3") 
      oPPTShape.TextFrame.TextRange.Text = c.Offset(, 8).Value 
      Set oPPTShape = oPPTFile.Slides(SlideNum + 1).Shapes("Oval" & (i + 1) & "4") 
      oPPTShape.TextFrame.TextRange.Text = c.Offset(, 9).Value 


    End Sub 

Answer 1

Да, в том числе формы в группе возникает ошибка. Вы можете разгруппировать формы или использовать функцию для возвращения ссылки на необходимую форму, даже если он находится в группе:

Function ShapeNamed(sName As String, oSlide As Slide) As Shape 

    Dim oSh As Shape 
    Dim x As Long 

    For Each oSh In oSlide.Shapes 
     If oSh.Name = sName Then 
      Set ShapeNamed = oSh 
      Exit Function 
     End If 
     If oSh.Type = msoGroup Then 
      For x = 1 To oSh.GroupItems.Count 
       If oSh.GroupItems(x).Name = sName Then 
        Set ShapeNamed = oSh.GroupItems(x) 
       End If 
      Next 
     End If 

    Next 

End Function 

Sub TestItOut() 
    Dim oSh as Shape 
    Set oSh = ShapeNamed("Oval 5", ActivePresentation.Slides(1)) 
    If not oSh is Nothing Then 
     If ValueFromExcel < 0 then 
     oSh.Fill.ForeColor.RGB = RGB(255,0,0) 
     Else 
     oSh.Fill.ForeColor.RGB = RGB(0,255,0) 
     End if 
    End If 
End Sub