Excel VBA - 循环遍历 powerpoint 形状并识别不在 Excel 范围内的文本行

Excel VBA - 循环遍历 powerpoint 形状并识别不在 Excel 范围内的文本行

我正在编写一个宏来识别 PowerPoint 形状中的文本行是否不存在 Excel 范围内。

最后一个循环中的想法是,如果在 Excel 范围内未找到形状中的文本行,则记录该行。它不起作用,因为代码返回形状中的所有行,这意味着未找到任何行,如果我添加条件,Not它不会返回任何行,即使是不在 Excel 范围内的行。

有任何想法吗?

这是我的代码:

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 键;行 = 您输入了换行符或行被自动换行符分隔)

相关内容