☰

Excel VBA - パワーポイントの図形をループし、Excel の範囲外のテキスト行を識別する

tag-icon • tag-icon microsoft-excel vba automation microsoft-powerpoint
Excel VBA - パワーポイントの図形をループし、Excel の範囲外のテキスト行を識別する

PowerPoint 図形内のテキスト行が Excel 範囲内に存在しないかどうかを識別するマクロを作成しています。

最後のループの考え方は、図形内のテキスト行が Excel 範囲内に見つからない場合、それが記録されるというものです。コードは図形内のすべての行を返すため、何も見つからなかったことを意味し、条件を追加すると、NotExcel 範囲内にない行も含めて、どの行も返されないため、これは機能しません。

何か案は？

これが私のコードです:

Sub Updt_OrgChart_Test1()

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide

Set PPApp = CreateObject("Powerpoint.Application")

PPApp.Visible = True


Set PPPres = PPApp.Presentations("presentation 2016.pptx")
Set PPSlide = PPPres.Slides(6)

Dim wb As Workbook
Dim teste_ws As Worksheet
Dim SDA_ws As Worksheet

Set wb = ThisWorkbook
Set teste_ws = wb.Sheets("Teste")
Set SDA_ws = wb.Sheets("FZ SW KRK SDA")

Dim shp As PowerPoint.Shape

Dim L5AndTeam As String
L5AndTeam = SDA_ws.Range("C3")
Dim Employee_Rng As Range
Set Employee_Rng = SDA_ws.Range(Range("B8"), Range("B8").End(xlDown))

For Each shp In PPSlide.Shapes
     On Error Resume Next
     If shp.TextFrame.HasText Then
       If shp.TextFrame.TextRange.Lines.Count > 2 Then
         If Left(shp.Name, 3) = "Rec" Then
            Dim prg As PowerPoint.TextRange
            For Each prg In shp.TextFrame.TextRange.Paragraphs
                Dim nm As String
                nm = prg
                If Employee_Rng.Find(nm.Value) Is Nothing Then
                   MsgBox nm  <---- this is just a test, will add more code here
                End If
            Next prg
           End If
        End If
     End If
Next shp

End Sub

答え1

図形の TextRange の Paragraphs または Lines コレクションを反復処理する方がよい場合があります。テキスト ボックスが選択されていることを前提とした簡単な例:

Sub Thing()

Dim oSh As Shape
Dim x As Long

Set oSh = ActiveWindow.Selection.ShapeRange(1)

If oSh.HasTextFrame Then
    With oSh.TextFrame.TextRange
        For x = 1 To .Paragraphs.Count
            Debug.Print .Paragraphs(x).Text
        Next
        For x = 1 To .Lines.Count
            Debug.Print .Lines(x).Text
        Next
    End With
End If

End Sub

段落または行を移動できることに注意してください (段落 = 段落の最後に ENTER キーを入力した場合、行 = 改行を入力した場合、または行がワードラップによって分割された場合)

関連情報