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;行 = 您已鍵入換行符或該行已被自動換行打斷)

相關內容