Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Макрос последовательной печати результатов автофильтра - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос последовательной печати результатов автофильтра (Макросы/Sub)
Макрос последовательной печати результатов автофильтра
DARR Дата: Понедельник, 10.12.2018, 14:20 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Добрый день! Помогите пожалуйста с макросом последовательной печати результатов автофильтра столбца R. В моём примере это критерии Иванов, Петров, Сидоров. В основной таблице критериев будет больше...
К сообщению приложен файл: 777.xlsm(22.7 Kb)
 
Ответить
СообщениеДобрый день! Помогите пожалуйста с макросом последовательной печати результатов автофильтра столбца R. В моём примере это критерии Иванов, Петров, Сидоров. В основной таблице критериев будет больше...

Автор - DARR
Дата добавления - 10.12.2018 в 14:20
boa Дата: Понедельник, 10.12.2018, 15:21 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 325
Репутация: 71 ±
Замечаний: 0% ±

2013, 365
DARR,
[vba]
Код
Sub NewMacros()
    Dim f, Coll As New Collection
    On Error Resume Next
    With ActiveWorkbook.ActiveSheet.UsedRange.Offset(4) 'т.е. начинаем перебор с 5-й строки
         For Each f In .Columns(18).Value
            If f <> "" Then Coll.Add CStr(f), CStr(f)
         Next f
         For Each f In Coll
            .AutoFilter Field:=18, Criteria1:=f
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
         Next f
    End With
End Sub
[/vba]
К сообщению приложен файл: 1640047.xlsm(27.1 Kb)


 
Ответить
СообщениеDARR,
[vba]
Код
Sub NewMacros()
    Dim f, Coll As New Collection
    On Error Resume Next
    With ActiveWorkbook.ActiveSheet.UsedRange.Offset(4) 'т.е. начинаем перебор с 5-й строки
         For Each f In .Columns(18).Value
            If f <> "" Then Coll.Add CStr(f), CStr(f)
         Next f
         For Each f In Coll
            .AutoFilter Field:=18, Criteria1:=f
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
         Next f
    End With
End Sub
[/vba]

Автор - boa
Дата добавления - 10.12.2018 в 15:21
DARR Дата: Вторник, 11.12.2018, 09:52 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
boa, макрос работает, спасибо, но есть недостаток.. в ячейке R3 вставлена формула, которая отображает критерий автофильтра. При распечатке макросом формула не работает, т.е. в ячейке R3 критерий автофильтра не вставляется(
 
Ответить
Сообщениеboa, макрос работает, спасибо, но есть недостаток.. в ячейке R3 вставлена формула, которая отображает критерий автофильтра. При распечатке макросом формула не работает, т.е. в ячейке R3 критерий автофильтра не вставляется(

Автор - DARR
Дата добавления - 11.12.2018 в 09:52
boa Дата: Вторник, 11.12.2018, 10:03 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 325
Репутация: 71 ±
Замечаний: 0% ±

2013, 365
DARR,

Добавьте после установки автофильтра, перед выводом на печать, строку
[vba]
Код
Cells(3, 18).Calculate
[/vba]

З.Ы. А может надо просто включить в параметрах автопересчет, т.к. у меня на компе стоит ручной и параметр мог унаследоваться вместе с файлом.




Сообщение отредактировал boa - Вторник, 11.12.2018, 10:04
 
Ответить
СообщениеDARR,

Добавьте после установки автофильтра, перед выводом на печать, строку
[vba]
Код
Cells(3, 18).Calculate
[/vba]

З.Ы. А может надо просто включить в параметрах автопересчет, т.к. у меня на компе стоит ручной и параметр мог унаследоваться вместе с файлом.

Автор - boa
Дата добавления - 11.12.2018 в 10:03
DARR Дата: Вторник, 11.12.2018, 10:26 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
boa,
[vba]
Код
Sub NewMacros()
    Dim f, Coll As New Collection
    On Error Resume Next
    With ActiveWorkbook.ActiveSheet.UsedRange.Offset(4) 'т.е. начинаем перебор с 5-й строки
         For Each f In .Columns(18).Value
            If f <> "" Then Coll.Add CStr(f), CStr(f)
         Next f
         For Each f In Coll
            .AutoFilter Field:=18, Criteria1:=f
            Cells(3, 18).Calculate
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
         Next f
    End With
End Sub
[/vba]
В таком виде не сработало


Сообщение отредактировал DARR - Вторник, 11.12.2018, 10:27
 
Ответить
Сообщениеboa,
[vba]
Код
Sub NewMacros()
    Dim f, Coll As New Collection
    On Error Resume Next
    With ActiveWorkbook.ActiveSheet.UsedRange.Offset(4) 'т.е. начинаем перебор с 5-й строки
         For Each f In .Columns(18).Value
            If f <> "" Then Coll.Add CStr(f), CStr(f)
         Next f
         For Each f In Coll
            .AutoFilter Field:=18, Criteria1:=f
            Cells(3, 18).Calculate
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
         Next f
    End With
End Sub
[/vba]
В таком виде не сработало

Автор - DARR
Дата добавления - 11.12.2018 в 10:26
boa Дата: Вторник, 11.12.2018, 10:34 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 325
Репутация: 71 ±
Замечаний: 0% ±

2013, 365
DARR,
все верно,
у меня работает
ну попробуйте
[vba]
Код
ActiveWorkbook.ActiveSheet.Cells(3, 18).Calculate
[/vba]
или пересчитывайте весь лист, может адрес ячейки не правильно указан
[vba]
Код
ActiveWorkbook.ActiveSheet.Calculate
[/vba]


 
Ответить
СообщениеDARR,
все верно,
у меня работает
ну попробуйте
[vba]
Код
ActiveWorkbook.ActiveSheet.Cells(3, 18).Calculate
[/vba]
или пересчитывайте весь лист, может адрес ячейки не правильно указан
[vba]
Код
ActiveWorkbook.ActiveSheet.Calculate
[/vba]

Автор - boa
Дата добавления - 11.12.2018 в 10:34
DARR Дата: Вторник, 11.12.2018, 11:46 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
boa, мистика какая то, но ничего не помогает. Ни первый вариант (адрес ячейки правильно указан), ни второй вариант (пересчёт всего листа) не помогает. Я попробовал [vba]
Код
ActiveWorkbook.ActiveSheet.Cells(3, 18).Calculate
[/vba] запустить отдельным макросом после выполнения первого, то формула сразу же срабатывает. А в составе первого макроса почему то не работает. Теряюсь в догадках почему такое может быть) Автопересчёт галочка стоит
 
Ответить
Сообщениеboa, мистика какая то, но ничего не помогает. Ни первый вариант (адрес ячейки правильно указан), ни второй вариант (пересчёт всего листа) не помогает. Я попробовал [vba]
Код
ActiveWorkbook.ActiveSheet.Cells(3, 18).Calculate
[/vba] запустить отдельным макросом после выполнения первого, то формула сразу же срабатывает. А в составе первого макроса почему то не работает. Теряюсь в догадках почему такое может быть) Автопересчёт галочка стоит

Автор - DARR
Дата добавления - 11.12.2018 в 11:46
DARR Дата: Вторник, 11.12.2018, 12:29 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
[vba]
Код
Sub NewMacros()
    Dim f, Coll As New Collection
    On Error Resume Next
    With ActiveWorkbook.ActiveSheet.UsedRange.Offset(4) 'т.е. начинаем перебор с 5-й строки
         For Each f In .Columns(18).Value
            If f <> "" Then Coll.Add CStr(f), CStr(f)
         Next f
         For Each f In Coll
            .AutoFilter Field:=18, Criteria1:=f
            Range("R3").FormulaR1C1 = "=GetCriteria(R[2]C)"
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
         Next f
    End With
End Sub
[/vba]
Получилось только в таком виде. Теперь как надо работает))
 
Ответить
Сообщение[vba]
Код
Sub NewMacros()
    Dim f, Coll As New Collection
    On Error Resume Next
    With ActiveWorkbook.ActiveSheet.UsedRange.Offset(4) 'т.е. начинаем перебор с 5-й строки
         For Each f In .Columns(18).Value
            If f <> "" Then Coll.Add CStr(f), CStr(f)
         Next f
         For Each f In Coll
            .AutoFilter Field:=18, Criteria1:=f
            Range("R3").FormulaR1C1 = "=GetCriteria(R[2]C)"
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
         Next f
    End With
End Sub
[/vba]
Получилось только в таком виде. Теперь как надо работает))

Автор - DARR
Дата добавления - 11.12.2018 в 12:29
boa Дата: Вторник, 11.12.2018, 12:34 | Сообщение № 9
Группа: Проверенные
Ранг: Обитатель
Сообщений: 325
Репутация: 71 ±
Замечаний: 0% ±

2013, 365
DARR,
что бы не делать лишних пересчетов, можно еще так:
[vba]
Код
Range("R3").value = f
[/vba]


 
Ответить
СообщениеDARR,
что бы не делать лишних пересчетов, можно еще так:
[vba]
Код
Range("R3").value = f
[/vba]

Автор - boa
Дата добавления - 11.12.2018 в 12:34
DARR Дата: Вторник, 11.12.2018, 13:55 | Сообщение № 10
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
boa, можно ещё вопрос...? Когда в моей таблице стоит фильтр на столбце Q (на "не пустые ячейки"), то в столбце R пропадают некоторые критерии автофильтра и, соответственно, они не должны распечатываться. Макрос же печатает все, что есть в столбце R, без учёта фильтра на столбце Q. Как сделать так, чтобы распечатывалось с учётом фильтра, на столбце Q? Надеюсь понятно объяснил)


Сообщение отредактировал DARR - Вторник, 11.12.2018, 13:57
 
Ответить
Сообщениеboa, можно ещё вопрос...? Когда в моей таблице стоит фильтр на столбце Q (на "не пустые ячейки"), то в столбце R пропадают некоторые критерии автофильтра и, соответственно, они не должны распечатываться. Макрос же печатает все, что есть в столбце R, без учёта фильтра на столбце Q. Как сделать так, чтобы распечатывалось с учётом фильтра, на столбце Q? Надеюсь понятно объяснил)

Автор - DARR
Дата добавления - 11.12.2018 в 13:55
boa Дата: Вторник, 11.12.2018, 19:31 | Сообщение № 11
Группа: Проверенные
Ранг: Обитатель
Сообщений: 325
Репутация: 71 ±
Замечаний: 0% ±

2013, 365
DARR,
Макрос же печатает все, что есть в столбце R, без учёта фильтра на столбце Q
я так понимаю, что он печатает листы в которых строки с данными не отображаются?
Фильтр же в столбце Q не сбрасывается?
тогда так
[vba]
Код
...
         If .Cells(.Rows.Count, 18).End(xlUp).Row > 4 Then _
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
         Next f
...
[/vba]




Сообщение отредактировал boa - Вторник, 11.12.2018, 20:27
 
Ответить
СообщениеDARR,
Макрос же печатает все, что есть в столбце R, без учёта фильтра на столбце Q
я так понимаю, что он печатает листы в которых строки с данными не отображаются?
Фильтр же в столбце Q не сбрасывается?
тогда так
[vba]
Код
...
         If .Cells(.Rows.Count, 18).End(xlUp).Row > 4 Then _
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
         Next f
...
[/vba]

Автор - boa
Дата добавления - 11.12.2018 в 19:31
DARR Дата: Среда, 12.12.2018, 08:57 | Сообщение № 12
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
boa, Теперь всё работает идеально, большое спасибо за помощь!
 
Ответить
Сообщениеboa, Теперь всё работает идеально, большое спасибо за помощь!

Автор - DARR
Дата добавления - 12.12.2018 в 08:57
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос последовательной печати результатов автофильтра (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2019 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!