TPE
Tavvafi@gmail.com |
≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡
چنین لیستی را در نظر داریم:
Text [tab] Text Text [tab] Text Text [tab] Text
یا مثلا این لیست:
Text [tab] Text [tab] Text [tab] Text Text [tab] Text [tab] Text [tab] Text Text [tab] Text [tab] Text [tab] Text
برای اضافه کردن خطوط راهنمای Leader به متن جدول بندی شده، متن را انتخاب می کنیم و این ماکرو را اجرا می کنیم:
Sub LeaderLines() Dim oSh As Shape Dim oRng As TextRange Dim oSld As Slide Dim x As Long Dim oLine As Shape Dim TabInstance As Long Dim LineCounter As Long Set oSh = ActiveWindow.Selection.ShapeRange(1) Set oRng = oSh.TextFrame.TextRange Set oSld = oSh.Parent With oRng For LineCounter = 1 To .Lines.Count With .Lines(LineCounter) TabInstance = 0 For x = 1 To .Characters.Count If .Characters(x) = vbTab Then TabInstance = TabInstance + 1 If IsOdd(TabInstance) Then With .Characters(x) Set oLine = oSld.Shapes.AddLine(.BoundLeft, _ .BoundTop + .Boundheight, _ .BoundLeft + .Boundwidth, _ .BoundTop + .Boundheight) With oLine .Fill.Transparency = 0# .Line.Weight = 3# .Line.DashStyle = msoLineRoundDot End With End With End If End If Next End With Next ' line End With End Sub Function IsOdd(lInput As Long) As Boolean If lInput \ 2 = lInput / 2 Then IsOdd = False Else IsOdd = True End If End Function