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

Вход

Регистрация

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

 

= Мир MS Excel/Парольный доступ к страницам. - Мир MS Excel

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

Excel 2010
Здравствуйте.

Помню тут уже была подобная тема но я что-то ее пока не сумел найти.

Каким образом можно осуществить вход на определенную страницу по определенному паролю ?

Желательно что бы страницы соответствующие данному паролю были доступны для редактирования и просмотра другие не доступны для редактирования и просмотра.

Спасибо .
 
Ответить
СообщениеЗдравствуйте.

Помню тут уже была подобная тема но я что-то ее пока не сумел найти.

Каким образом можно осуществить вход на определенную страницу по определенному паролю ?

Желательно что бы страницы соответствующие данному паролю были доступны для редактирования и просмотра другие не доступны для редактирования и просмотра.

Спасибо .

Автор - koyaanisqatsi
Дата добавления - 15.04.2016 в 09:57
koyaanisqatsi Дата: Пятница, 15.04.2016, 10:08 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 610
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
koyaanisqatsi,

Нашел этот пост от Бороды.

Хороший пример только видны все страницы. Хотелось бы чтоб под каждым паролем были доступны свои страницы.
К сообщению приложен файл: 11332244_1.xlsb(25Kb)


Сообщение отредактировал koyaanisqatsi - Пятница, 15.04.2016, 10:10
 
Ответить
Сообщениеkoyaanisqatsi,

Нашел этот пост от Бороды.

Хороший пример только видны все страницы. Хотелось бы чтоб под каждым паролем были доступны свои страницы.

Автор - koyaanisqatsi
Дата добавления - 15.04.2016 в 10:08
Невилл Дата: Пятница, 15.04.2016, 10:11 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 70
Репутация: 2 ±
Замечаний: 0% ±

Excel 2007
Макрос повесить на Worksheet_Activate простой Inputbox
 
Ответить
СообщениеМакрос повесить на Worksheet_Activate простой Inputbox

Автор - Невилл
Дата добавления - 15.04.2016 в 10:11
Pelena Дата: Пятница, 15.04.2016, 10:16 | Сообщение № 4
Группа: Модераторы
Ранг: Экселист
Сообщений: 9857
Репутация: 2254 ±
Замечаний: 0% ±

Excel 2010 & Mac Excel 2011
Нашел этот пост от Бороды.

А чуть выше пост с ссылкой не увидели?


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
Сообщение
Нашел этот пост от Бороды.

А чуть выше пост с ссылкой не увидели?

Автор - Pelena
Дата добавления - 15.04.2016 в 10:16
_Boroda_ Дата: Пятница, 15.04.2016, 10:16 | Сообщение № 5
Группа: Модераторы
Ранг: Экселист
Сообщений: 9367
Репутация: 3940 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
только видны все страницы.

Где видны? Как раз наоборот вроде должно быть.
Хотелось бы чтоб под каждым паролем были доступны свои страницы

Так там так и есть.
Или я чего-то не понял?


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
только видны все страницы.

Где видны? Как раз наоборот вроде должно быть.
Хотелось бы чтоб под каждым паролем были доступны свои страницы

Так там так и есть.
Или я чего-то не понял?

Автор - _Boroda_
Дата добавления - 15.04.2016 в 10:16
Невилл Дата: Пятница, 15.04.2016, 10:19 | Сообщение № 6
Группа: Пользователи
Ранг: Участник
Сообщений: 70
Репутация: 2 ±
Замечаний: 0% ±

Excel 2007
Бред написал, не увидел прошлый пост...


Сообщение отредактировал Невилл - Пятница, 15.04.2016, 10:20
 
Ответить
СообщениеБред написал, не увидел прошлый пост...

Автор - Невилл
Дата добавления - 15.04.2016 в 10:19
koyaanisqatsi Дата: Пятница, 15.04.2016, 10:20 | Сообщение № 7
Группа: Проверенные
Ранг: Ветеран
Сообщений: 610
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
_Boroda_, Да и правда некоторые страницы работают правильно. Иванов выдает все страницы. А я его изначально и проверял.
 
Ответить
Сообщение_Boroda_, Да и правда некоторые страницы работают правильно. Иванов выдает все страницы. А я его изначально и проверял.

Автор - koyaanisqatsi
Дата добавления - 15.04.2016 в 10:20
_Boroda_ Дата: Пятница, 15.04.2016, 10:31 | Сообщение № 8
Группа: Модераторы
Ранг: Экселист
Сообщений: 9367
Репутация: 3940 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Иванов выдает все страницы

Это потому, что Вы его после Шефа открыли. Согласен, косяк.
Переделал
К сообщению приложен файл: 4545452.xlsb(23Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
Иванов выдает все страницы

Это потому, что Вы его после Шефа открыли. Согласен, косяк.
Переделал

Автор - _Boroda_
Дата добавления - 15.04.2016 в 10:31
koyaanisqatsi Дата: Пятница, 15.04.2016, 10:38 | Сообщение № 9
Группа: Проверенные
Ранг: Ветеран
Сообщений: 610
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
_Boroda_, Во Кажись красотень, Спасибо ! посмотрим смогу ли воплотить организацию коммуникации по средствам этого.
 
Ответить
Сообщение_Boroda_, Во Кажись красотень, Спасибо ! посмотрим смогу ли воплотить организацию коммуникации по средствам этого.

Автор - koyaanisqatsi
Дата добавления - 15.04.2016 в 10:38
koyaanisqatsi Дата: Пятница, 15.04.2016, 11:09 | Сообщение № 10
Группа: Проверенные
Ранг: Ветеран
Сообщений: 610
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
_Boroda_,
На листе "доп" изобразил права доступа, помогите пожалуйста в соответствии с этим правилами раздать доступ.

Спасибо.
К сообщению приложен файл: 7317110.xlsb(26Kb)
 
Ответить
Сообщение_Boroda_,
На листе "доп" изобразил права доступа, помогите пожалуйста в соответствии с этим правилами раздать доступ.

Спасибо.

Автор - koyaanisqatsi
Дата добавления - 15.04.2016 в 11:09
_Boroda_ Дата: Пятница, 15.04.2016, 11:25 | Сообщение № 11
Группа: Модераторы
Ранг: Экселист
Сообщений: 9367
Репутация: 3940 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Это у Вас все переписывать нужно, а я сейчас больше, чем на 5 минут отвлекаться от работы не могу. Возможно, вечером.
Если никто больше не сделает, а я забуду, то напомните мне потом.


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеЭто у Вас все переписывать нужно, а я сейчас больше, чем на 5 минут отвлекаться от работы не могу. Возможно, вечером.
Если никто больше не сделает, а я забуду, то напомните мне потом.

Автор - _Boroda_
Дата добавления - 15.04.2016 в 11:25
SLAVICK Дата: Пятница, 15.04.2016, 11:34 | Сообщение № 12
Группа: Модераторы
Ранг: Старожил
Сообщений: 1838
Репутация: 613 ±
Замечаний: 0% ±

2007,2010,2013,2016
Если никто больше не сделает

Уже :D - интересно стало.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) <> "B2" Then Exit Sub
    On Error Resume Next
    p_ = WorksheetFunction.VLookup(Range("B1"), Лист4.[A2:B999], 2, False)
    shs = WorksheetFunction.VLookup(Range("B1"), Лист4.[A2:c999], 3, False)
        On Error GoTo 0
    If Range("B2") <> p_ Then MsgBox "Неверный пароль": Exit Sub
    sk_ = ThisWorkbook.Sheets.Count
    sa_ = ActiveSheet.Name
    
    If Len(shs) = 0 Then
        For i = 2 To ThisWorkbook.Sheets.Count
        Sheets(i).Visible = xlSheetVisible
        Next
    Else
        For i = 2 To ThisWorkbook.Sheets.Count
        Sheets(i).Visible = IIf(InStr(1, shs, ThisWorkbook.Sheets(i).Name, vbTextCompare) = 0, xlSheetVeryHidden, xlSheetVisible)
        Next
    End If
End Sub
[/vba]
Немного изменил алгоритм Александра.
Для пользователя нужно указать список доступных листов.
Если ячейка с листами пустая - показывает все листы.
К сообщению приложен файл: 6893193.xlsb(28Kb)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
Если никто больше не сделает

Уже :D - интересно стало.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) <> "B2" Then Exit Sub
    On Error Resume Next
    p_ = WorksheetFunction.VLookup(Range("B1"), Лист4.[A2:B999], 2, False)
    shs = WorksheetFunction.VLookup(Range("B1"), Лист4.[A2:c999], 3, False)
        On Error GoTo 0
    If Range("B2") <> p_ Then MsgBox "Неверный пароль": Exit Sub
    sk_ = ThisWorkbook.Sheets.Count
    sa_ = ActiveSheet.Name
    
    If Len(shs) = 0 Then
        For i = 2 To ThisWorkbook.Sheets.Count
        Sheets(i).Visible = xlSheetVisible
        Next
    Else
        For i = 2 To ThisWorkbook.Sheets.Count
        Sheets(i).Visible = IIf(InStr(1, shs, ThisWorkbook.Sheets(i).Name, vbTextCompare) = 0, xlSheetVeryHidden, xlSheetVisible)
        Next
    End If
End Sub
[/vba]
Немного изменил алгоритм Александра.
Для пользователя нужно указать список доступных листов.
Если ячейка с листами пустая - показывает все листы.

Автор - SLAVICK
Дата добавления - 15.04.2016 в 11:34
koyaanisqatsi Дата: Пятница, 15.04.2016, 11:42 | Сообщение № 13
Группа: Проверенные
Ранг: Ветеран
Сообщений: 610
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
SLAVICK, Вроде все как надо. Спасибо красота !
 
Ответить
СообщениеSLAVICK, Вроде все как надо. Спасибо красота !

Автор - koyaanisqatsi
Дата добавления - 15.04.2016 в 11:42
koyaanisqatsi Дата: Среда, 18.05.2016, 14:00 | Сообщение № 14
Группа: Проверенные
Ранг: Ветеран
Сообщений: 610
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
SLAVICK, Здравствуй. Что-то я поломал. И не знаю куда искать где смотреть.
При выборе пользователя и ввода пароля 444 Макрос выдает ошибку дебаг или ЕНД
предлагает поискать проблему в этой строке.

Что привело к поломке не знаю. Добавлял страницы удалял ненужные. Добавлял в список отображаемых еще страниц.
Но уже в сломанном файле делал многое чтобы понять в чем причина и список страниц корректировал убавлял его до одной. Пока ничего не помогло.

[vba]
Код
Sheets(i).Visible = IIf(InStr(1, shs, ThisWorkbook.Sheets(i).Name, vbTextCompare) = 0, xlSheetVeryHidden, xlSheetVisible)
[/vba]

Ошибка: Нельзя установить свойство Visible класса Workshieet

Причем если сначала зайти под админом а потом зайти под пользователем то ошибку не выдает.

К сожалению файл уже вырос до 200кб.

Кажется я понял что проблема в двух кодах из основания книги.
1 код для скрытия листов
2 код ля календаря

1-вы код

[vba]
Код
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
      Application.OnKey "^v": Application.OnKey "^V"
    Application.OnKey "^x": Application.OnKey "^X"
    Dim li As Long
    With Application.CommandBars("Cell")
        For li = 1 To .Controls.Count: .Controls(li).Visible = True: Next li
    End With
    
    scr
End Sub

Private Sub Workbook_Open()

If ActiveSheet.Name = "Лист5" Then
        Application.OnKey "^v", "": Application.OnKey "^V", ""
        Application.OnKey "^x", "": Application.OnKey "^X", ""
    End If

    scr
End Sub
[/vba]

2-ой код (пытался что-то зарепортить чтобы хоть как-то подружить эти два кода.

[vba]
Код
'Option Explicit
'Private WithEvents Appl As Application   ' объявляем объект Application для того, чтобы можно было отлавливать события других книг

Private Sub Appl_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
   On Error Resume Next
   With JP_Сalendar_Frm
      If .Visible Then .UserForm_Activate
   End With
End Sub

Private Sub Appl_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
   If TypeName(Selection) <> "Range" Then Exit Sub
   With Target(1, 1)
      If .HasFormula Then Exit Sub
      If IsDate(.Value) Then
         JP_Сalendar_Frm.Show 0   '(vbModeless)
         Cancel = True   'не входить в режим редактирования ячейки
      End If
   End With
End Sub

' Sub Reload_Appl(): Set Appl = Application: End Sub  ' "патч" (у меня почему-то иногда теряется определение Appl)

[/vba]


Сообщение отредактировал koyaanisqatsi - Четверг, 19.05.2016, 08:35
 
Ответить
СообщениеSLAVICK, Здравствуй. Что-то я поломал. И не знаю куда искать где смотреть.
При выборе пользователя и ввода пароля 444 Макрос выдает ошибку дебаг или ЕНД
предлагает поискать проблему в этой строке.

Что привело к поломке не знаю. Добавлял страницы удалял ненужные. Добавлял в список отображаемых еще страниц.
Но уже в сломанном файле делал многое чтобы понять в чем причина и список страниц корректировал убавлял его до одной. Пока ничего не помогло.

[vba]
Код
Sheets(i).Visible = IIf(InStr(1, shs, ThisWorkbook.Sheets(i).Name, vbTextCompare) = 0, xlSheetVeryHidden, xlSheetVisible)
[/vba]

Ошибка: Нельзя установить свойство Visible класса Workshieet

Причем если сначала зайти под админом а потом зайти под пользователем то ошибку не выдает.

К сожалению файл уже вырос до 200кб.

Кажется я понял что проблема в двух кодах из основания книги.
1 код для скрытия листов
2 код ля календаря

1-вы код

[vba]
Код
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
      Application.OnKey "^v": Application.OnKey "^V"
    Application.OnKey "^x": Application.OnKey "^X"
    Dim li As Long
    With Application.CommandBars("Cell")
        For li = 1 To .Controls.Count: .Controls(li).Visible = True: Next li
    End With
    
    scr
End Sub

Private Sub Workbook_Open()

If ActiveSheet.Name = "Лист5" Then
        Application.OnKey "^v", "": Application.OnKey "^V", ""
        Application.OnKey "^x", "": Application.OnKey "^X", ""
    End If

    scr
End Sub
[/vba]

2-ой код (пытался что-то зарепортить чтобы хоть как-то подружить эти два кода.

[vba]
Код
'Option Explicit
'Private WithEvents Appl As Application   ' объявляем объект Application для того, чтобы можно было отлавливать события других книг

Private Sub Appl_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
   On Error Resume Next
   With JP_Сalendar_Frm
      If .Visible Then .UserForm_Activate
   End With
End Sub

Private Sub Appl_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
   If TypeName(Selection) <> "Range" Then Exit Sub
   With Target(1, 1)
      If .HasFormula Then Exit Sub
      If IsDate(.Value) Then
         JP_Сalendar_Frm.Show 0   '(vbModeless)
         Cancel = True   'не входить в режим редактирования ячейки
      End If
   End With
End Sub

' Sub Reload_Appl(): Set Appl = Application: End Sub  ' "патч" (у меня почему-то иногда теряется определение Appl)

[/vba]

Автор - koyaanisqatsi
Дата добавления - 18.05.2016 в 14:00
koyaanisqatsi Дата: Четверг, 19.05.2016, 08:37 | Сообщение № 15
Группа: Проверенные
Ранг: Ветеран
Сообщений: 610
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
А может быть можно сделать чтобы пользователь вообще без пароля видел перечисленные листы, а с паролем уже были бы видны листы только для избранных ? Но надо чтобы все равно календарь дружил с этим макросом скрытия листов.
 
Ответить
СообщениеА может быть можно сделать чтобы пользователь вообще без пароля видел перечисленные листы, а с паролем уже были бы видны листы только для избранных ? Но надо чтобы все равно календарь дружил с этим макросом скрытия листов.

Автор - koyaanisqatsi
Дата добавления - 19.05.2016 в 08:37
_Boroda_ Дата: Четверг, 19.05.2016, 09:14 | Сообщение № 16
Группа: Модераторы
Ранг: Экселист
Сообщений: 9367
Репутация: 3940 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Sheets(i).Visible = IIf(InStr(1, shs, ThisWorkbook.Sheets(i).Name, vbTextCompare) = 0, xlSheetVeryHidden, xlSheetVisible)
Ошибка: Нельзя установить свойство Visible класса Workshieet

Поищите у себя в коде - похоже, Вы пытаетесь скрыть последний видимый лист в книге. Возможно у Вас сначала ненужные листы скрываются, а затем нужные показываются и когда-нибудь наступает такой момент, когда в книге остается видимым один единственный лист и код должен его скрыть, что, конечно же, вызывает ошибку.
Нужно наоборот - сначала показывать нужные листы, а затем скрывать ненужные. Тогда в файле всегда будет видимым хотя бы один лист.


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
Sheets(i).Visible = IIf(InStr(1, shs, ThisWorkbook.Sheets(i).Name, vbTextCompare) = 0, xlSheetVeryHidden, xlSheetVisible)
Ошибка: Нельзя установить свойство Visible класса Workshieet

Поищите у себя в коде - похоже, Вы пытаетесь скрыть последний видимый лист в книге. Возможно у Вас сначала ненужные листы скрываются, а затем нужные показываются и когда-нибудь наступает такой момент, когда в книге остается видимым один единственный лист и код должен его скрыть, что, конечно же, вызывает ошибку.
Нужно наоборот - сначала показывать нужные листы, а затем скрывать ненужные. Тогда в файле всегда будет видимым хотя бы один лист.

Автор - _Boroda_
Дата добавления - 19.05.2016 в 09:14
koyaanisqatsi Дата: Четверг, 19.05.2016, 09:22 | Сообщение № 17
Группа: Проверенные
Ранг: Ветеран
Сообщений: 610
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
_Boroda_, по параметру Visible нашел на каждой страничке
такой код:

[vba]
Код
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim ivIDArray, li As Long, i As Integer: ivIDArray = Array("В&ырезать", "Вст&авить значения", "Вст&авить", "Специальная вс&тавка...", "Вс&тавить...", "&Удалить...")
    With Application.CommandBars("Cell")
        For li = 1 To .Controls.Count
            For i = LBound(ivIDArray) To UBound(ivIDArray)
                If .Controls(li).Caption = ivIDArray(i) Then .Controls(li).Visible = False:
            Next i
        Next li
    End With
End Sub
[/vba]

это оно ?

Вот на первой стартовой страничке есть такой код

[vba]
Код
     Else
        For i = 2 To ThisWorkbook.Sheets.Count
        Sheets(i).Visible = IIf(InStr(1, shs, ThisWorkbook.Sheets(i).Name, vbTextCompare) = 0, xlSheetVeryHidden, xlSheetVisible)
        Next
    End If
End Sub
[/vba]


Сообщение отредактировал koyaanisqatsi - Четверг, 19.05.2016, 09:25
 
Ответить
Сообщение_Boroda_, по параметру Visible нашел на каждой страничке
такой код:

[vba]
Код
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim ivIDArray, li As Long, i As Integer: ivIDArray = Array("В&ырезать", "Вст&авить значения", "Вст&авить", "Специальная вс&тавка...", "Вс&тавить...", "&Удалить...")
    With Application.CommandBars("Cell")
        For li = 1 To .Controls.Count
            For i = LBound(ivIDArray) To UBound(ivIDArray)
                If .Controls(li).Caption = ivIDArray(i) Then .Controls(li).Visible = False:
            Next i
        Next li
    End With
End Sub
[/vba]

это оно ?

Вот на первой стартовой страничке есть такой код

[vba]
Код
     Else
        For i = 2 To ThisWorkbook.Sheets.Count
        Sheets(i).Visible = IIf(InStr(1, shs, ThisWorkbook.Sheets(i).Name, vbTextCompare) = 0, xlSheetVeryHidden, xlSheetVisible)
        Next
    End If
End Sub
[/vba]

Автор - koyaanisqatsi
Дата добавления - 19.05.2016 в 09:22
SLAVICK Дата: Четверг, 19.05.2016, 09:30 | Сообщение № 18
Группа: Модераторы
Ранг: Старожил
Сообщений: 1838
Репутация: 613 ±
Замечаний: 0% ±

2007,2010,2013,2016
это оно ?

нет
на первой стартовой страничке есть такой код

А вот это может быть. Вы стартовый лист поставили первым, как в примере? или перемещали его?
Кажется я понял что проблема в двух кодах из основания книги.

Так покажите в примере - откуда мы знаем что там не так.


Иногда все проще чем кажется с первого взгляда.

Сообщение отредактировал SLAVICK - Четверг, 19.05.2016, 09:33
 
Ответить
Сообщение
это оно ?

нет
на первой стартовой страничке есть такой код

А вот это может быть. Вы стартовый лист поставили первым, как в примере? или перемещали его?
Кажется я понял что проблема в двух кодах из основания книги.

Так покажите в примере - откуда мы знаем что там не так.

Автор - SLAVICK
Дата добавления - 19.05.2016 в 09:30
koyaanisqatsi Дата: Четверг, 19.05.2016, 09:32 | Сообщение № 19
Группа: Проверенные
Ранг: Ветеран
Сообщений: 610
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
SLAVICK, Стартовый лист не трогал.

вот весь код стартовой странички.

[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    If Target.Address(0, 0) <> "B2" Then
        Application.CutCopyMode = False
        If Target.Address(0, 0) <> "B1" Then Range("B1").Select
    End If
    On Error GoTo 0
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) <> "B2" Then Exit Sub
    On Error Resume Next
    p_ = WorksheetFunction.VLookup(Range("B1"), Лист4.[A2:B999], 2, False)
    shs = WorksheetFunction.VLookup(Range("B1"), Лист4.[A2:c999], 3, False)
        On Error GoTo 0
    If Range("B2") <> p_ Then MsgBox "Неверный пароль": Exit Sub
    sk_ = ThisWorkbook.Sheets.Count
    sa_ = ActiveSheet.Name

    If Len(shs) = 0 Then
        For i = 2 To ThisWorkbook.Sheets.Count
        Sheets(i).Visible = xlSheetVisible
        Next
    Else
        For i = 2 To ThisWorkbook.Sheets.Count
        Sheets(i).Visible = IIf(InStr(1, shs, ThisWorkbook.Sheets(i).Name, vbTextCompare) = 0, xlSheetVeryHidden, xlSheetVisible)
        Next
    End If
End Sub
[/vba]

уДАЛЕНО АДМИНИСТРАЦИЕЙ
надеюсь меня не побьют за ссылку на файл на другой сайт...</a>
[moder]Побьют.


Сообщение отредактировал _Boroda_ - Четверг, 19.05.2016, 09:43
 
Ответить
СообщениеSLAVICK, Стартовый лист не трогал.

вот весь код стартовой странички.

[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    If Target.Address(0, 0) <> "B2" Then
        Application.CutCopyMode = False
        If Target.Address(0, 0) <> "B1" Then Range("B1").Select
    End If
    On Error GoTo 0
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) <> "B2" Then Exit Sub
    On Error Resume Next
    p_ = WorksheetFunction.VLookup(Range("B1"), Лист4.[A2:B999], 2, False)
    shs = WorksheetFunction.VLookup(Range("B1"), Лист4.[A2:c999], 3, False)
        On Error GoTo 0
    If Range("B2") <> p_ Then MsgBox "Неверный пароль": Exit Sub
    sk_ = ThisWorkbook.Sheets.Count
    sa_ = ActiveSheet.Name

    If Len(shs) = 0 Then
        For i = 2 To ThisWorkbook.Sheets.Count
        Sheets(i).Visible = xlSheetVisible
        Next
    Else
        For i = 2 To ThisWorkbook.Sheets.Count
        Sheets(i).Visible = IIf(InStr(1, shs, ThisWorkbook.Sheets(i).Name, vbTextCompare) = 0, xlSheetVeryHidden, xlSheetVisible)
        Next
    End If
End Sub
[/vba]

уДАЛЕНО АДМИНИСТРАЦИЕЙ
надеюсь меня не побьют за ссылку на файл на другой сайт...</a>
[moder]Побьют.

Автор - koyaanisqatsi
Дата добавления - 19.05.2016 в 09:32
_Boroda_ Дата: Четверг, 19.05.2016, 09:41 | Сообщение № 20
Группа: Модераторы
Ранг: Экселист
Сообщений: 9367
Репутация: 3940 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Похоже на то, что не оно. Где Вы там видите Sheets(i).Visible =...? это какие-то куски кодов, да еще без файла - я анализировать не возьмусь.
Короче - ищите где скрываете листы - что-то типа [vba]
Код
Sheets(i).Visible =0
[/vba]и перед циклом скрытия вставьте цикл показа. Скачайте заново мой файл из отсюда и проанализируйте код
[vba]
Код
    sk_ = ThisWorkbook.Sheets.Count
    Sheets("Старт").Visible = xlSheetVisible
    For i = 1 To sk_
        If Sheets(i).Name <> "Старт" Then
            Sheets(i).Visible = xlSheetVeryHidden
        End If
    Next i
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеПохоже на то, что не оно. Где Вы там видите Sheets(i).Visible =...? это какие-то куски кодов, да еще без файла - я анализировать не возьмусь.
Короче - ищите где скрываете листы - что-то типа [vba]
Код
Sheets(i).Visible =0
[/vba]и перед циклом скрытия вставьте цикл показа. Скачайте заново мой файл из отсюда и проанализируйте код
[vba]
Код
    sk_ = ThisWorkbook.Sheets.Count
    Sheets("Старт").Visible = xlSheetVisible
    For i = 1 To sk_
        If Sheets(i).Name <> "Старт" Then
            Sheets(i).Visible = xlSheetVeryHidden
        End If
    Next i
[/vba]

Автор - _Boroda_
Дата добавления - 19.05.2016 в 09:41
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Парольный доступ к страницам. (Макросы/Sub)
Страница 1 из 212»
Поиск:

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