-
Hi Airborne,
I've been playing around with an Index solution and come up with the following
This code has to be inserted in each of your workbooks
[VBA] Option Explicit
Option Base 1
Sub GetBoxText()
Dim MyWS As Worksheet
Dim BoxText()
Dim i!, j!
'If no Data sheet then exit sub
Sheets("Data").Select
If Err <> 0 Then Exit Sub
'Create FindWord sheet if it does not exist
On Error Resume Next
Sheets("FindWord").Select
If Err <> 0 Then
'error occured so clear it
Err.Clear
Sheets.Add.Name = "MyIndex"
Sheets("MyIndex").Move After:=Sheets(Sheets.Count)
End If
Set MyWS = ActiveWorkbook.Sheets("Data")
ReDim BoxText(MyWS.Shapes.Count)
For i = 1 To MyWS.Shapes.Count
If Left(MyWS.Shapes(i).Name, 5) = "Text " Then
j = j + 1
BoxText(j) = MyWS.Shapes(i).TextFrame.Characters.Text
End If
Next i
ReDim Preserve BoxText(j)
Sheets("MyIndex").UsedRange.ClearContents
For i = 1 To j
Sheets("MyIndex").Cells(i, 1) = BoxText(i)
Next
End Sub
[/VBA]
and also the following which calls the code, to keep things up to date
[VBA]
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
GetBoxText
End Sub
[/VBA]
You can then run a slightly modified version of DRJs FinalAll programme as attached.
I'm sure with your experience now, you can iron out any version bugs!
MD
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules