我正在编写一个宏来识别 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 键;行 = 您输入了换行符或行被自动换行符分隔)