VBA：在Powerpoint中写入椭圆的Excel单元格值

我正在尝试在PowerPoint中向几个椭圆（已经创build和定位的形状）添加文本。 这些值是从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