Application.ScreenUpdating not working?

gmayor · #2 04-28-2017, 10:40 PM

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

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