#1
|
|||
|
|||
Application.ScreenUpdating not working?
Hi all,
Before I start, I will admit I posted this in a forum that helps me a lot with another Office product, but as of this post they were not able to shed any light on this issue. I created the code below which does what it was written for, BUT the screen updates whilst it runs. The screen flickers (presumably when opening each document)? Is there a way to suppress this.? I was offered Appliication.Echo as a solution, but that is not recognised in Word 2007? TIA Code:
Sub InsertText() Dim Shp As Shape, Doc As Document, strTextToInsert As String, strTextToFind As String Dim i As Long, docToOpen As FileDialog, sHght As Single Dim rngToSearch As Word.Range Dim DataObj As New MSForms.DataObject On Error GoTo Err_Exit 'strText = InputBox("New Text", "Header Textbox Update", "New Text") ' Switch off the updates of screen Application.ScreenUpdating = False ' Set the text strTextToInsert = "Annual bonus rates for the last five years" strTextToFind = "Discharge Pack" DataObj.SetText strTextToInsert DataObj.PutInClipboard Set docToOpen = Application.FileDialog(msoFileDialogFilePicker) docToOpen.Show For i = 1 To docToOpen.SelectedItems.Count 'Open each document Set Doc = Documents.Open(FileName:=docToOpen.SelectedItems(i)) Selection.Find.ClearFormatting With Selection.Find .Text = strTextToFind .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.TypeParagraph Selection.PasteAndFormat (wdListCombineWithExistingList) ' The above inserts a line which creates a second page, so delete a line after Selection.EndKey Unit:=wdStory Selection.Delete Unit:=wdCharacter, Count:=1 ActiveDocument.Close SaveChanges:=wdSaveChanges Next Set docToOpen = Nothing: Set Doc = Nothing ' Switch Screen updates back on Application.ScreenUpdating = True Exit Sub Err_Exit: MsgBox Err.Description & Err.Number End Sub |
#2
|
||||
|
||||
If you don't want to have the flicker as the documents are opened, open the documents invisibly. This can result in you not knowing whether the process is still running, but the easy answer to that is to use a progress indicator bar. You can download a userform to do this from my web site - http://www.gmayor.com/Zips/ProgressBar.zip Extract the files from the zip and import to the VBA project. The following code has been adjusted to use that progress bar.
The code you were using is somewhat convoluted. It is neither necessary nor desirable to write a text string to the clipboard in order to write it to the document. You just have to set the range you have defined to the place where the text is to be inserted. It appears that you want to locate the text "Discharge Pack" and insert a paragraph break after it and write the text to the start of that new paragraph. The following does that for the first instance of the found text (matching the case). Remove the line indicated to search for every instance. Code:
Sub InsertText() Dim Doc As Document, strTextToInsert As String, strTextToFind As String Dim i As Long, docToOpen As FileDialog, sHght As Single Dim rngToSearch As Word.Range Dim oFrm As frmProgress Dim PortionDone As Double On Error GoTo Err_Exit strTextToInsert = "Annual bonus rates for the last five years" strTextToFind = "Discharge Pack" Set docToOpen = Application.FileDialog(msoFileDialogFilePicker) If docToOpen.Show = -1 Then Set oFrm = New frmProgress If docToOpen.SelectedItems.Count > 1 Then oFrm.Show vbModeless Application.ScreenUpdating = False For i = 1 To docToOpen.SelectedItems.Count If docToOpen.SelectedItems.Count > 1 Then PortionDone = i / docToOpen.SelectedItems.Count oFrm.lblProgress.Width = oFrm.fmeProgress.Width * PortionDone oFrm.Caption = "Processing document " & i - 1 & " of " & docToOpen.SelectedItems.Count End If 'Open each document Set Doc = Documents.Open _ (FileName:=docToOpen.SelectedItems(i), _ Visible:=False, _ AddtoRecentFiles:=False) Set rngToSearch = Doc.Range With rngToSearch.Find Do While .Execute(FindText:=strTextToFind, MatchCase:=True) rngToSearch.Collapse 0 rngToSearch.Text = vbCr & strTextToInsert rngToSearch.Collapse 0 Exit Do 'If you only want to process the first instance Loop End With Doc.Close SaveChanges:=wdSaveChanges DoEvents Next Unload oFrm Application.ScreenUpdating = True MsgBox "Processing complete" End If lbl_Exit: Set Doc = Nothing Set docToOpen = Nothing Set rngToSearch = Nothing Exit Sub Err_Exit: MsgBox Err.Description & Err.Number Err.Clear GoTo lbl_Exit End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
|||
|
|||
Wow!
Thank you very much gmayor. As you will no doubt gathered I am a novice at VBA and this attempt was just trying to emulate what I would do manually. Thank you for the progress indicator code and the tip on how to do this better and, I am always keen to learn new things if it will help me in life. Thank you also for rewriting the procedure. I'll give it a go on Tuesday when back in work. |
#4
|
|||
|
|||
That has worked a treat gmayor. Thank you.
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
What application to use? | pfergy | Office | 1 | 03-12-2011 08:46 PM |
Application.FileSearch | cksm4 | Word VBA | 0 | 08-19-2010 02:18 PM |
Best application to use? | FrankW | Office | 2 | 06-13-2009 01:16 AM |
What is Application Automation and How can I use it in VBA | KramerJ | Excel | 0 | 03-30-2009 12:59 PM |
Application.Caller | pankajkankaria | Excel | 0 | 03-18-2009 11:48 AM |