Уважаемые форумчане. Подскажите пожалуйста. Никак не могу понять как реализовть заставку при открытии книги, чтобы она висела пока выполнялся макрос по сбору информации?! В тексте, который ниже, появляется заставка, но пока ее не закроешь макрос работать не будет.    
 
Private Sub Workbook_Open()  
 
Collect  
 
 
End Sub  
 
 
Макрос:  
Option Explicit  
Sub Collect()  
 
UserForm1.Show  
 
Dim BazaWb As Workbook    'текущая книга (общий файл)  
   Dim BazaSht As Worksheet    'лист Price-group в общем файле  
   Dim iTempFileName As String    'имя поочерёдно открываемого файла  
   Dim iPath As String    'путь к папке, где лежат все файлы  
   Dim iLastRowBaza As Long    'последняя заполненная строка в общем файле в столбце C  
   Dim iLastRowTempWb As Long    'последняя заполненная строка в по-очерёдно открываемом файле в столбце C  
   Dim iNumFiles As Long    'количество открываемых файлов  
 
   Dim lr&, rr As Range  
 
   With Application  
       .ScreenUpdating = False  
       .DisplayAlerts = False  
       .Calculation = xlManual  
       Set BazaWb = ThisWorkbook  
       Set BazaSht = BazaWb.Sheets("ДанныеGPS")  
       iPath = BazaWb.Path & "\Данные_по_GPS\"  
       iTempFileName = Dir(iPath & "*.xls")  
         
       Sheets("ДанныеGPS").Select 'обнуление данных gps  
       Range("A3:BA1000").Select  
       Selection.ClearContents  
         
       Do While iTempFileName <> ""  
           If iTempFileName <> BazaWb.Name Then  
               With .Workbooks.Open _  
                    (Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=True)  
                   iNumFiles = iNumFiles + 1  
                   'Рабочая книга не должна быть защищена паролем  
                   With .Worksheets(1)  
                       iLastRowTempWb = .Cells(Rows.Count, 3).End(xlUp).Row  
                       iLastRowBaza = BazaSht.Cells(Rows.Count, 4).End(xlUp).Row + 1 'тут заменил 3 на 4!!! - не работало!  
                       '.Range(.Cells(3, 1), .Cells(iLastRowTempWb, "AA")).Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)  
                         
                       '=======================  
                       lr = .Cells(1, 1).SpecialCells(xlLastCell).Row  
                       With .Rows(7)  
                           .AutoFilter Field:=4, Criteria1:="=нет данных"  
                           .AutoFilter Field:=9, Criteria1:="=24:00:00"  
                       End With  
                       Set rr = Intersect(.UsedRange.SpecialCells(xlCellTypeVisible), _  
                                          .Range(.Cells(8, 1), .Cells(lr, "AA")))  
                       If Not rr Is Nothing Then rr.Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)  
                       .Rows(7).AutoFilter ' а это и не обязательно - всё равно закрываем без сохранения  
                       '=======================  
                     
                   End With  
                   .Close saveChanges:=False  
               End With  
           End If  
           iTempFileName = Dir  
       Loop  
       .Calculation = xlAutomatic  
       .DisplayAlerts = True  
       .ScreenUpdating = True  
   End With  
 
   UserForm1.Hide  
 
   MsgBox "Информация собрана из " & iNumFiles & " файлов!", vbInformation, "Конец"  
End Sub