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

Вход

Регистрация

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

 

= Мир MS Excel/Скрытые ячейки по условию - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Скрытые ячейки по условию (Макросы/Sub)
Скрытые ячейки по условию
ekut Дата: Вторник, 16.08.2022, 10:29 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 195
Репутация: 3 ±
Замечаний: 0% ±

Excel 2007
Уважаемые Екселисты! Если не трудно, помогите!!! Необходимо скрыть листы, кроме Список, Сальдо и Перечень, с возможностью сохранять их без формул. В списке с помощью галочки я сохраняю листы без формул. А скрытые листы без формул сохранить не могу!!! Благодарю заранее
К сообщению приложен файл: __.rar (461.9 Kb)
 
Ответить
СообщениеУважаемые Екселисты! Если не трудно, помогите!!! Необходимо скрыть листы, кроме Список, Сальдо и Перечень, с возможностью сохранять их без формул. В списке с помощью галочки я сохраняю листы без формул. А скрытые листы без формул сохранить не могу!!! Благодарю заранее
Автор - ekut
Дата добавления - 16.08.2022 в 10:29
msi2102 Дата: Вторник, 16.08.2022, 11:05 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 413
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Попробуйте так
[vba]
Код
Sub SaveList()
    Dim Wsh As Worksheet, shSpis As Worksheet
    Dim iPath  As String
    Dim cell As Range, cellls As Range
    Set shSpis = ThisWorkbook.Worksheets("Список")
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
    End With
    iPath = ThisWorkbook.Path & "\Списание ТМЦ уч.св.№5\"            '
    'проверяем есть ли такая папка, если нет, то создаем
    If Dir(iPath, vbDirectory) = "" Then MkDir iPath
    rrow = shSpis.Cells(Rows.Count, 1).End(xlUp).Row
'=====================================================================================================
    i = 0 ' флаг скрыт или нет лист
'=====================================================================================================
    For t = 2 To rrow
        For Each Wsh In Worksheets      'цикл по листам, кроме Список
            If Wsh.Name <> "Список" Then
                If shSpis.Range("A" & t) = "a" And shSpis.Range("b" & t) = Wsh.Name Then
'=====================================================================================================
                If Wsh.Visible = False Then i = 1: Wsh.Visible = True ' проверка скрыт лист или нет, если скрат, по показать
'=====================================================================================================
                    Wsh.Copy    'копируем очередной лист
                    ActiveSheet.UsedRange.Copy
                    ActiveSheet.UsedRange.PasteSpecial xlValues
                    ActiveWorkbook.Close SaveChanges:=True
'=====================================================================================================
                    If i = 1 Then i = 0: Wsh.Visible = False ' проверка если лист был скрыт то скрывает его
'=====================================================================================================
                End If
            End If
        Next
    Next
    With Application
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub
[/vba]
 
Ответить
СообщениеПопробуйте так
[vba]
Код
Sub SaveList()
    Dim Wsh As Worksheet, shSpis As Worksheet
    Dim iPath  As String
    Dim cell As Range, cellls As Range
    Set shSpis = ThisWorkbook.Worksheets("Список")
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
    End With
    iPath = ThisWorkbook.Path & "\Списание ТМЦ уч.св.№5\"            '
    'проверяем есть ли такая папка, если нет, то создаем
    If Dir(iPath, vbDirectory) = "" Then MkDir iPath
    rrow = shSpis.Cells(Rows.Count, 1).End(xlUp).Row
'=====================================================================================================
    i = 0 ' флаг скрыт или нет лист
'=====================================================================================================
    For t = 2 To rrow
        For Each Wsh In Worksheets      'цикл по листам, кроме Список
            If Wsh.Name <> "Список" Then
                If shSpis.Range("A" & t) = "a" And shSpis.Range("b" & t) = Wsh.Name Then
'=====================================================================================================
                If Wsh.Visible = False Then i = 1: Wsh.Visible = True ' проверка скрыт лист или нет, если скрат, по показать
'=====================================================================================================
                    Wsh.Copy    'копируем очередной лист
                    ActiveSheet.UsedRange.Copy
                    ActiveSheet.UsedRange.PasteSpecial xlValues
                    ActiveWorkbook.Close SaveChanges:=True
'=====================================================================================================
                    If i = 1 Then i = 0: Wsh.Visible = False ' проверка если лист был скрыт то скрывает его
'=====================================================================================================
                End If
            End If
        Next
    Next
    With Application
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub
[/vba]
Автор - msi2102
Дата добавления - 16.08.2022 в 11:05
ekut Дата: Вторник, 16.08.2022, 11:31 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 195
Репутация: 3 ±
Замечаний: 0% ±

Excel 2007
Спасибо за быстрый ответ! Только проблема в том, что изначально сохраненные листы без формул сохранялись в указанную папку в макросе автоматически и с названием листа! А сейчас Книгой 1 и 2.
 
Ответить
СообщениеСпасибо за быстрый ответ! Только проблема в том, что изначально сохраненные листы без формул сохранялись в указанную папку в макросе автоматически и с названием листа! А сейчас Книгой 1 и 2.
Автор - ekut
Дата добавления - 16.08.2022 в 11:31
msi2102 Дата: Вторник, 16.08.2022, 11:35 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 413
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Прошу прощения, это я удалил лишнюю строку
[vba]
Код
Sub SaveList()
    Dim Wsh As Worksheet, shSpis As Worksheet
    Dim iPath  As String
    Dim cell As Range, cellls As Range
    Set shSpis = ThisWorkbook.Worksheets("Список")
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
    End With
    iPath = ThisWorkbook.Path & "\Списание ТМЦ уч.св.№5\"            '
    'проверяем есть ли такая папка, если нет, то создаем
    If Dir(iPath, vbDirectory) = "" Then MkDir iPath
    rrow = shSpis.Cells(Rows.Count, 1).End(xlUp).Row
'=====================================================================================================
    i = 0 ' флаг скрыт или нет лист
'=====================================================================================================
    For t = 2 To rrow
        For Each Wsh In Worksheets      'цикл по листам, кроме Список
            If Wsh.Name <> "Список" Then
                If shSpis.Range("A" & t) = "a" And shSpis.Range("b" & t) = Wsh.Name Then
'=====================================================================================================
                If Wsh.Visible = False Then i = 1: Wsh.Visible = True ' проверка скрыт лист или нет, если скрат, по показать
'=====================================================================================================
                    Wsh.Copy    'копируем очередной лист
                    ActiveSheet.UsedRange.Copy
                    ActiveSheet.UsedRange.PasteSpecial xlValues
                    ActiveWorkbook.SaveAs iPath & Wsh.Name & ".xlsx"    'в подпапку СИЗ уч.св.№5
                    ActiveWorkbook.Close SaveChanges:=True
'=====================================================================================================
                    If i = 1 Then i = 0: Wsh.Visible = False ' проверка если лист был скрыт то скрывает его
'=====================================================================================================
                End If
            End If
        Next
    Next
    With Application
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub
[/vba]


Сообщение отредактировал msi2102 - Вторник, 16.08.2022, 11:36
 
Ответить
СообщениеПрошу прощения, это я удалил лишнюю строку
[vba]
Код
Sub SaveList()
    Dim Wsh As Worksheet, shSpis As Worksheet
    Dim iPath  As String
    Dim cell As Range, cellls As Range
    Set shSpis = ThisWorkbook.Worksheets("Список")
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
    End With
    iPath = ThisWorkbook.Path & "\Списание ТМЦ уч.св.№5\"            '
    'проверяем есть ли такая папка, если нет, то создаем
    If Dir(iPath, vbDirectory) = "" Then MkDir iPath
    rrow = shSpis.Cells(Rows.Count, 1).End(xlUp).Row
'=====================================================================================================
    i = 0 ' флаг скрыт или нет лист
'=====================================================================================================
    For t = 2 To rrow
        For Each Wsh In Worksheets      'цикл по листам, кроме Список
            If Wsh.Name <> "Список" Then
                If shSpis.Range("A" & t) = "a" And shSpis.Range("b" & t) = Wsh.Name Then
'=====================================================================================================
                If Wsh.Visible = False Then i = 1: Wsh.Visible = True ' проверка скрыт лист или нет, если скрат, по показать
'=====================================================================================================
                    Wsh.Copy    'копируем очередной лист
                    ActiveSheet.UsedRange.Copy
                    ActiveSheet.UsedRange.PasteSpecial xlValues
                    ActiveWorkbook.SaveAs iPath & Wsh.Name & ".xlsx"    'в подпапку СИЗ уч.св.№5
                    ActiveWorkbook.Close SaveChanges:=True
'=====================================================================================================
                    If i = 1 Then i = 0: Wsh.Visible = False ' проверка если лист был скрыт то скрывает его
'=====================================================================================================
                End If
            End If
        Next
    Next
    With Application
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub
[/vba]
Автор - msi2102
Дата добавления - 16.08.2022 в 11:35
ekut Дата: Вторник, 16.08.2022, 12:51 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 195
Репутация: 3 ±
Замечаний: 0% ±

Excel 2007
Огромноеееее спасибоооо!!!!
 
Ответить
СообщениеОгромноеееее спасибоооо!!!!
Автор - ekut
Дата добавления - 16.08.2022 в 12:51
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Скрытые ячейки по условию (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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