Excel. Потеря ActiveSheet - VB

Узнай цену своей работы

Формулировка задачи:

доброго времени суток, уважаемые
Подскажите пожалуйста существуют ли приемы условно говоря всех объектов Excel и заполнения только конкретного экземпляра?
Ситуация следущая: Имеется приложение, которое по кнопке выводит пользователю отчет с форматированием не только шапки, но и всего объема данных (условно говоря секционирование строк + форматирование по центру в первом столбце каждой секции)
в зависимости от объема данных отчет может заполняться до 50 секунд
В это время пользователь хочет работать в другом (своем) экземпляре Excel, и как только он позиционирует курсор на своем экселевом файле, то теряется ссылка на ActiveSheet, ну и возникает ошибка "Application-defined or object-defined error"
выгружать данные через буфер - не вариант, потому как не понимаю как можно будет задать указанное форматирование.
собственно, может ли кто-нибудь помочь советом по вопросу блокировки всех экземпляров Excel или поделиться опытом в случае удачного решения описанной проблемы.
_________________________________

Решение задачи: «Excel. Потеря ActiveSheet»

textual
Листинг программы 
<font color="blue">Sub</font> RollingData()
<font color="00AA00">'</font>
<font color="00AA00">' Макрос1 Макрос</font>
<font color="00AA00">' Макрос записан 14.01.2009 (user)</font>
<font color="00AA00">'</font>

<font color="00AA00">'</font>
<font color="blue">Dim</font> sCurrentFiltRange <font color="blue">As</font> <font color="blue">String</font>
<font color="blue">Dim</font> r <font color="blue">As</font> Range
<font color="blue">Dim</font> s <font color="blue">As</font> Worksheet, sh <font color="blue">As</font> Worksheet, shOut <font color="blue">As</font> Worksheet, w <font color="blue">As</font> Workbook, w1 <font color="blue">As</font> Workbook
<font color="blue">Dim</font> vPriznak <font color="blue">As</font> Variant
<font color="blue">Dim</font> vMonth <font color="blue">As</font> Variant
<font color="blue">Dim</font> vGroup <font color="blue">As</font> Variant

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

<font color="blue">Set</font> w = Application.ActiveWorkbook
<font color="blue">Set</font> sh = Worksheets(<font color="teal">"филиал"</font>)
sCurrentFiltRange = sh.AutoFilter.Range.Address

<font color="blue">Set</font> w1 = Application.Workbooks.Add
Application.DisplayAlerts = False
w1.PrecisionAsDisplayed = True
w1.Worksheets(<font color="teal">"Лист1"</font>).Delete
w.Worksheets(<font color="teal">"Результат"</font>).Delete
Application.DisplayAlerts = True

<font color="blue">Set</font> s = w1.Worksheets.Add
s.<font color="blue">Name</font> = <font color="teal">"Лист1"</font>
<font color="blue">Set</font> s = <font color="blue">Nothing</font>

<font color="blue">Set</font> s = w.Worksheets.Add
s.<font color="blue">Name</font> = <font color="teal">"Результат"</font>

<font color="00AA00">' Получаем список уникальных комбинаций из</font>
<font color="00AA00">' признак филиал-Укрнафта или ещё какой-то,</font>
<font color="00AA00">' месяца оплаты, номера платёжного поручения,</font>
<font color="00AA00">' группы, вида и суммы оплаты</font>
<font color="blue">Set</font> r = Worksheets(<font color="teal">"Лист1"</font>).Range(<font color="teal">"a1"</font>)
sh.Range(<font color="teal">"P:U"</font>).AdvancedFilter xlFilterCopy, , r, True
Application.DisplayAlerts = False
w1.PrecisionAsDisplayed = False
DoEvents
w1.PrecisionAsDisplayed = True
vGroup = r.Range(<font color="teal">"a2:F"</font> + CStr(r.SpecialCells(xlCellTypeLastCell).Row - <font color="darkblue"><b>1</b></font>)).Value2
Application.DisplayAlerts = True

w.Activate
s.<font color="blue">Select</font>
<font color="blue">Dim</font> iPriz <font color="blue">As</font> <font color="blue">Long</font>, iMonth <font color="blue">As</font> <font color="blue">Long</font>, iGr <font color="blue">As</font> <font color="blue">Long</font>, i <font color="blue">As</font> <font color="blue">Long</font>, nCurrRow <font color="blue">As</font> <font color="blue">Long</font>, bFirst <font color="blue">As</font> <font color="blue">Boolean</font>
nCurrRow = <font color="darkblue"><b>2</b></font>
<font color="blue">Dim</font> ar <font color="blue">As</font> Areas
<font color="blue">For</font> iGr = LBound(vGroup) <font color="blue">To</font> UBound(vGroup)
    <font color="blue">With</font> sh.Range(sCurrentFiltRange)

        .AutoFilter Field:=<font color="darkblue"><b>16</b></font>, Criteria1:=CStr(vGroup(iGr, <font color="darkblue"><b>1</b></font>)) <font color="00AA00">'<font color="teal">"январь"</font></font>
        .AutoFilter Field:=<font color="darkblue"><b>17</b></font>, Criteria1:=CStr(vGroup(iGr, <font color="darkblue"><b>2</b></font>)) <font color="00AA00">'<font color="teal">"филиал"</font></font>
        .AutoFilter Field:=<font color="darkblue"><b>18</b></font>, Criteria1:=CStr(vGroup(iGr, <font color="darkblue"><b>3</b></font>)) <font color="00AA00">'№ платежки</font>
        .AutoFilter Field:=<font color="darkblue"><b>19</b></font>, Criteria1:=CStr(vGroup(iGr, <font color="darkblue"><b>4</b></font>)) <font color="00AA00">'<font color="teal">"группа"</font></font>
        .AutoFilter Field:=<font color="darkblue"><b>20</b></font>, Criteria1:=CStr(vGroup(iGr, <font color="darkblue"><b>5</b></font>)) <font color="00AA00">'<font color="teal">"статья"</font></font>
        .AutoFilter Field:=<font color="darkblue"><b>21</b></font>, Criteria1:=Replace(Trim(Format(vGroup(iGr, <font color="darkblue"><b>6</b></font>), <font color="teal">"#,##0.00"</font>)), <font color="teal">","</font>, <font color="teal">"."</font>) 
<font color="00AA00">'w1.Worksheets(<font color="teal">"Лист1"</font>).Cells(iGr + 1, 5) 'Trim(Format(vGroup(iGr, 5), <font color="teal">"#,##0.00"</font>))   '<font color="teal">"62,76"</font></font>
        <font color="00AA00">'DoEvents</font>
        <font color="blue">For</font> <font color="blue">Each</font> r <font color="blue">In</font> sh.Range(sCurrentFiltRange).SpecialCells(xlCellTypeVisible).Areas
            i = i + r.Rows.Count <font color="00AA00">' .SpecialCells(xlCellTypeVisible).Rows.Count</font>
        <font color="blue">Next</font> r
        <font color="blue">If</font> i > <font color="darkblue"><b>1</b></font> <font color="blue">Then</font>
            bFirst = True
            <font color="blue">For</font> <font color="blue">Each</font> r <font color="blue">In</font> sh.Range(sCurrentFiltRange).SpecialCells(xlCellTypeVisible).Areas
                <font color="blue">If</font> r.Rows.Count > <font color="darkblue"><b>1</b></font> <font color="blue">Or</font> <font color="blue">Not</font> bFirst <font color="blue">Then</font>
                    r.Rows(<font color="darkblue"><b>1</b></font> + -<font color="darkblue"><b>1</b></font> * CLng(bFirst)).Copy
                    s.<font color="blue">Select</font>
                    s.Rows(nCurrRow).<font color="blue">Select</font>
                    s.Paste
                    s.Cells(nCurrRow, <font color="darkblue"><b>21</b></font>).Value = <font color="teal">"="</font> + Replace(CStr(s.Cells(nCurrRow, <font color="darkblue"><b>21</b></font>).Value), <font color="teal">","</font>, <font color="teal">"."</font>) + <font color="teal">"*"</font> + 
CStr(i - <font color="darkblue"><b>1</b></font>)
                    s.Cells(nCurrRow, <font color="darkblue"><b>31</b></font>).Value = CStr(i - <font color="darkblue"><b>1</b></font>)
                    nCurrRow = nCurrRow + <font color="darkblue"><b>1</b></font>
                    <font color="blue">Exit</font> <font color="blue">For</font>
                <font color="blue">Else</font>
                    bFirst = False
                <font color="blue">End</font> <font color="blue">If</font>
            <font color="blue">Next</font> r
        <font color="blue">Else</font>
            i = i
        <font color="blue">End</font> <font color="blue">If</font>
        Debug.<font color="blue">Print</font> i - <font color="darkblue"><b>1</b></font>, Round(CDbl(vGroup(iGr, <font color="darkblue"><b>6</b></font>)), <font color="darkblue"><b>2</b></font>), CStr(vGroup(iGr, <font color="darkblue"><b>1</b></font>)), CStr(vGroup(iGr, <font color="darkblue"><b>2</b></font>)), CStr(vGroup(iGr, 
<font color="darkblue"><b>3</b></font>)), CStr(iGr)
        i = <font color="darkblue"><b>0</b></font>
    <font color="blue">End</font> <font color="blue">With</font>
<font color="blue">Next</font> iGr
<font color="00AA00">' Отключаем автофильтры</font>
sh.ShowAllData
<font color="00AA00">' Закрываем книгу с уникальным списком</font>
sCurrentFiltRange = w1.<font color="blue">Name</font>
<font color="blue">Set</font> w1 = <font color="blue">Nothing</font>
Application.DisplayAlerts = False
Application.Workbooks(sCurrentFiltRange).<font color="blue">Close</font> (False)
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox <font color="teal">"Закончили!"</font>
<font color="blue">End</font> <font color="blue">Sub</font>

ИИ для рефератов и докладов

  • Экспорт Word по ГОСТу
  • Минимум 80% уникальности текста
  • Поиск релевантных источников в интернете
  • Готовый документ за 2 минуты

Оцени полезность:

7   голосов , оценка 4.143 из 5