![]() |
#4
|
||||
|
||||
![]()
Try:
Code:
Sub UpdateDocuments() Application.ScreenUpdating = False Dim strDocNm As String, strFolder As String, strFile As String, wdDoc As Document strFolder = GetFolder If strFolder = "" Then Exit Sub strFile = Dir(strFolder & "\*.doc", vbNormal) strDocNm = ThisDocument.FullName While strFile <> "" If strFolder & "\" & strFile <> strDocNm Then Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False) With wdDoc Call Foot2Inline(wdDoc) .Close SaveChanges:=True End With End If strFile = Dir() Wend Set wdDoc = Nothing Application.ScreenUpdating = True End Sub Function GetFolder() As String Dim oFolder As Object GetFolder = "" Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0) If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path Set oFolder = Nothing End Function Sub Foot2Inline(wdDoc As Document) Dim i As Long, Rng1 As Range, Rng2 As Range With wdDoc For i = .Footnotes.Count To 1 Step -1 With .Footnotes(i) Set Rng1 = .Reference Set Rng2 = .Range Rng2.End = Rng2.End - 1 With Rng1 .Collapse wdCollapseEnd .Font.Reset .FormattedText = Rng2.FormattedText .InsertBefore "[Note " & i & ": " .InsertAfter "]" .Font.Color = 6299648 End With .Delete End With Next End With End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
scvjudy | Word | 2 | 08-11-2014 10:58 PM |
![]() |
jemmac2525 | Word | 2 | 11-11-2013 12:32 AM |
Office 2010 Can't Open Or Save Documents in My Documents Folder | trippb | Office | 1 | 07-12-2013 07:29 AM |
![]() |
stevecarr | Word | 1 | 09-22-2011 05:32 AM |
Loop through folder of workbooks and copy range to other workbook | Snvlsfoal | Excel Programming | 3 | 07-29-2011 05:55 AM |