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

Вход

Регистрация

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

 

= Мир MS Excel/Макрос на скрытие и открытие строк - Мир MS Excel

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

Excel 2007
Добрый день!
[vba]
Код
Sub ПечатьСмета()
    If Range("F9").Value = "" Then
        If MsgBox("Материала нет в наличии. Хотите продолжить?", _
                vbExclamation + vbYesNo, "Сообщение макроса") = vbNo Then
            Exit Sub
        End If
    End If
    If Len(Range("H9")) Then
    Range("H4").Select
    Sheets("Забор").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, ActivePrinter:="Главный"
        Range("H4").Select
        Sheets("Воз").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, ActivePrinter:="Duplex Dogovor"
        Application.ScreenUpdating = False
    Dim sh As Worksheet, lr As Long, i As Long
    For Each sh In ThisWorkbook.Sheets
        If sh.Name Like "Скл*" Then
            With sh
                'If Not Intersect(.Range("A5:A31"), .UsedRange) Is Nothing Then
                lr = .Cells(Rows.Count, 1).End(xlUp).Row
                    q = 0
                    For Each cl In .Range("A5:A31").Cells
                        If cl.Value <> "" Then q = q + 1
                    Next cl
                If q > 0 Then
                    For i = lr To 5 Step -1
                        If .Cells(i, 1) = "" Then .Rows(i).Hidden = True
                    Next i
                    .PrintOut Copies:=1
                End If
            End With
        End If
    Next sh
    Application.ScreenUpdating = True
    

        Else
    MsgBox "Проверьте заполнение: номер договора, число, цвет, шапку заказа и красные ячейки!"
    End If
    Sheets("Забор").Select
End Sub
[/vba]

В этом коде, в листах (где есть хоть какая то информация в диапазоне A5:A31) Скл 1, Скл 2 и Скл 3 скрываются пустые строчки и после печатаются
Вопрос: Как сделать что бы они обратно открывались после того как напечатаются?
 
Ответить
СообщениеДобрый день!
[vba]
Код
Sub ПечатьСмета()
    If Range("F9").Value = "" Then
        If MsgBox("Материала нет в наличии. Хотите продолжить?", _
                vbExclamation + vbYesNo, "Сообщение макроса") = vbNo Then
            Exit Sub
        End If
    End If
    If Len(Range("H9")) Then
    Range("H4").Select
    Sheets("Забор").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, ActivePrinter:="Главный"
        Range("H4").Select
        Sheets("Воз").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, ActivePrinter:="Duplex Dogovor"
        Application.ScreenUpdating = False
    Dim sh As Worksheet, lr As Long, i As Long
    For Each sh In ThisWorkbook.Sheets
        If sh.Name Like "Скл*" Then
            With sh
                'If Not Intersect(.Range("A5:A31"), .UsedRange) Is Nothing Then
                lr = .Cells(Rows.Count, 1).End(xlUp).Row
                    q = 0
                    For Each cl In .Range("A5:A31").Cells
                        If cl.Value <> "" Then q = q + 1
                    Next cl
                If q > 0 Then
                    For i = lr To 5 Step -1
                        If .Cells(i, 1) = "" Then .Rows(i).Hidden = True
                    Next i
                    .PrintOut Copies:=1
                End If
            End With
        End If
    Next sh
    Application.ScreenUpdating = True
    

        Else
    MsgBox "Проверьте заполнение: номер договора, число, цвет, шапку заказа и красные ячейки!"
    End If
    Sheets("Забор").Select
End Sub
[/vba]

В этом коде, в листах (где есть хоть какая то информация в диапазоне A5:A31) Скл 1, Скл 2 и Скл 3 скрываются пустые строчки и после печатаются
Вопрос: Как сделать что бы они обратно открывались после того как напечатаются?

Автор - temnoo
Дата добавления - 14.07.2017 в 15:32
Manyasha Дата: Пятница, 14.07.2017, 15:37 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2008
Репутация: 837 ±
Замечаний: 0% ±

Excel 2010, 2016
temnoo, добавить
[vba]
Код
.cells.Rows.Hidden = false
[/vba] после строчки [vba]
Код
.PrintOut Copies:=1
[/vba]


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеtemnoo, добавить
[vba]
Код
.cells.Rows.Hidden = false
[/vba] после строчки [vba]
Код
.PrintOut Copies:=1
[/vba]

Автор - Manyasha
Дата добавления - 14.07.2017 в 15:37
KuklP Дата: Пятница, 14.07.2017, 16:57 | Сообщение № 3
Группа: Проверенные
Ранг: Старожил
Сообщений: 2340
Репутация: 479 ±
Замечаний: 0% ±

2003-2010
Мусора много в макросе.
[vba]
Код
Sub ПечатьСмета()
    If Range("F9").Value = "" And MsgBox("Материала нет в наличии. Хотите продолжить?", _
                  vbExclamation + vbYesNo, "Сообщение макроса") = vbNo Then Exit Sub
    If Len(Range("H9")) Then
        Sheets("Забор").PrintOut Copies:=1, Collate:=True, ActivePrinter:="Главный"
        Sheets("Воз").PrintOut Copies:=1, Collate:=True, ActivePrinter:="Duplex Dogovor"
        Application.ScreenUpdating = False
        Dim sh As Worksheet, lr As Long, i As Long
        For Each sh In ThisWorkbook.Sheets
            If sh.Name Like "Скл*" Then
                With sh
                    lr = .Cells(Rows.Count, 1).End(xlUp).Row
                    q = 0
                    On Error Resume Next
                    q = .Range("A5:A31").SpecialCells(2).Count
                    If q Then
                        Range(.Cells(5, 1), .Cells(lr, 1)).SpecialCells(4).EntireRow.Hidden = True
                        .PrintOut Copies:=1
                        .UsedRange.EntireRow.Hidden = 0
                    End If
                End With
            End If
        Next
        Application.ScreenUpdating = True
    Else
        MsgBox "Проверьте заполнение: номер договора, число, цвет, шапку заказа и красные ячейки!"
    End If
End Sub
[/vba]


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеМусора много в макросе.
[vba]
Код
Sub ПечатьСмета()
    If Range("F9").Value = "" And MsgBox("Материала нет в наличии. Хотите продолжить?", _
                  vbExclamation + vbYesNo, "Сообщение макроса") = vbNo Then Exit Sub
    If Len(Range("H9")) Then
        Sheets("Забор").PrintOut Copies:=1, Collate:=True, ActivePrinter:="Главный"
        Sheets("Воз").PrintOut Copies:=1, Collate:=True, ActivePrinter:="Duplex Dogovor"
        Application.ScreenUpdating = False
        Dim sh As Worksheet, lr As Long, i As Long
        For Each sh In ThisWorkbook.Sheets
            If sh.Name Like "Скл*" Then
                With sh
                    lr = .Cells(Rows.Count, 1).End(xlUp).Row
                    q = 0
                    On Error Resume Next
                    q = .Range("A5:A31").SpecialCells(2).Count
                    If q Then
                        Range(.Cells(5, 1), .Cells(lr, 1)).SpecialCells(4).EntireRow.Hidden = True
                        .PrintOut Copies:=1
                        .UsedRange.EntireRow.Hidden = 0
                    End If
                End With
            End If
        Next
        Application.ScreenUpdating = True
    Else
        MsgBox "Проверьте заполнение: номер договора, число, цвет, шапку заказа и красные ячейки!"
    End If
End Sub
[/vba]

Автор - KuklP
Дата добавления - 14.07.2017 в 16:57
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос на скрытие и открытие строк (Макросы/Sub)
Страница 1 из 11
Поиск:

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