Страницы: 1
RSS
For Each при условии в ячейке листа, корректировка макроса
 
Добрый день.
Макрос выводит в диапазоне наименование всех листов в книге в виде гиперссылок (оглавление).
Код
    Dim sheet As Worksheet
    Dim cell As Range
    With ActiveWorkbook
   
    Worksheets(8).Select
    Rows(70).Select
    Selection.ClearContents

    For Each sheet In ActiveWorkbook.Worksheets
         Set cell = Worksheets(8).Cells(70, sheet.Index + 2)
         .Worksheets(3).Hyperlinks.Add Anchor:=cell, Address:="", _
         SubAddress:="'" & sheet.Name & "'" & "!A1"
         cell.Formula = sheet.Name
    Next
    End With
    
    ActiveSheet.Calculate
Необходимо условие, если cells(1,2) = "Выводить", тогда данный лист выводится, в противном случае next.
Пробовал добавить цикл отдельно на проверку листов с такой ячейкой - не получилось =(
Код
For i = 9 To Sheets.Count
    Worksheets(i).Activate
    If Cells(1, 2) = "Выводить" Then
        Worksheets(i).Select
    End If
Next
Selection.Name = sheet
    
    With ActiveWorkbook
   
    Worksheets(8).Select
    Rows(70).Select
    Selection.ClearContents

    For Each sheet In ActiveWorkbook.Worksheets
         Set cell = Worksheets(8).Cells(70, sheet.Index + 2)
         .Worksheets(3).Hyperlinks.Add Anchor:=cell, Address:="", _
         SubAddress:="'" & sheet.Name & "'" & "!A1"
         cell.Formula = sheet.Name
    Next
    End With
    
    ActiveSheet.Calculate
Подскажите вариант чтоб в оглавление были наименование только тех листов , у которых "B1" = "Выводить".

Спасибо!
Изменено: cokos92 - 30.03.2015 13:54:21
 
Код
For Each sheet In ActiveWorkbook.Worksheets
    If sheet.Cells(1, 2) = "Выводить" Then
         Set cell = Worksheets(8).Cells(70, sheet.Index + 2)
         .Worksheets(3).Hyperlinks.Add Anchor:=cell, Address:="", _
         SubAddress:="'" & sheet.Name & "'" & "!A1"
         cell.Formula = sheet.Name
    End If
 Next

Искать нужно где потерял, а не где светло. ;)
 
Удалил. Совпало с решением RAN
Изменено: Sanja - 30.03.2015 13:31:16
Согласие есть продукт при полном непротивлении сторон
 
RAN,не поверишь. пробовал так, не получалось.
Спасибо тебе. =)
 
RAN, аааа....было просто cells вместо sheet.cells
 
Sanja, я обращаюсь на форум в крайнем случае. Конечно же пробовал искать.
И тебе спасибо за просмотр.
 
Цитата
Конечно же пробовал искать.
Вы меня не правильно поняли. Я выложил решение абсолютно такое-же как и RAN, поэтому после его удалил и заменил этой фразой, Вы не причем;)
Офф. Присвоение переменным имен совпадающих или сильно похожих на служебные слова VBA (как у Вас sheet, cell и т.п.) чревато ошибками и читаемость кода страдает
Изменено: Sanja - 30.03.2015 13:30:14
Согласие есть продукт при полном непротивлении сторон
 
Sanja, пример с этого же форума. Запомню Ваш совет.
Страницы: 1
Наверх