VBA：将Excel单元格值写入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