1

PowerPoint でいくつかの楕円形 (既に作成され配置されている図形) にテキストを追加しようとしています。値は Excel から読み取られます。また、PowerPoint の図形の色を変更したいと思います。値が 0 より大きい場合は緑に、0 より小さい場合は赤になります。これを試していますが、エラーが発生します。どんな助けでも大歓迎です。私は最初にAlt-H、S、L、Pを実行し、名前をダブルクリックしてOval11、Oval12などに変更しています。

バージョン：エクセル2010、パワーポイント2010

 '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
4

1 に答える 1

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
于 2013-08-22T16:04:28.190 に答える