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