Помню тут уже была подобная тема но я что-то ее пока не сумел найти.
Каким образом можно осуществить вход на определенную страницу по определенному паролю ?
Желательно что бы страницы соответствующие данному паролю были доступны для редактирования и просмотра другие не доступны для редактирования и просмотра.
Спасибо .
Здравствуйте.
Помню тут уже была подобная тема но я что-то ее пока не сумел найти.
Каким образом можно осуществить вход на определенную страницу по определенному паролю ?
Желательно что бы страницы соответствующие данному паролю были доступны для редактирования и просмотра другие не доступны для редактирования и просмотра.
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] Немного изменил алгоритм Александра. Для пользователя нужно указать список доступных листов. Если ячейка с листами пустая - показывает все листы.
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
SLAVICK, Здравствуй. Что-то я поломал. И не знаю куда искать где смотреть. При выборе пользователя и ввода пароля 444 Макрос выдает ошибку дебаг или ЕНД предлагает поискать проблему в этой строке.
Что привело к поломке не знаю. Добавлял страницы удалял ненужные. Добавлял в список отображаемых еще страниц. Но уже в сломанном файле делал многое чтобы понять в чем причина и список страниц корректировал убавлял его до одной. Пока ничего не помогло.
Ошибка: Нельзя установить свойство 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]
SLAVICK, Здравствуй. Что-то я поломал. И не знаю куда искать где смотреть. При выборе пользователя и ввода пароля 444 Макрос выдает ошибку дебаг или ЕНД предлагает поискать проблему в этой строке.
Что привело к поломке не знаю. Добавлял страницы удалял ненужные. Добавлял в список отображаемых еще страниц. Но уже в сломанном файле делал многое чтобы понять в чем причина и список страниц корректировал убавлял его до одной. Пока ничего не помогло.
Ошибка: Нельзя установить свойство 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)
А может быть можно сделать чтобы пользователь вообще без пароля видел перечисленные листы, а с паролем уже были бы видны листы только для избранных ? Но надо чтобы все равно календарь дружил с этим макросом скрытия листов.
А может быть можно сделать чтобы пользователь вообще без пароля видел перечисленные листы, а с паролем уже были бы видны листы только для избранных ? Но надо чтобы все равно календарь дружил с этим макросом скрытия листов.koyaanisqatsi
Sheets(i).Visible = IIf(InStr(1, shs, ThisWorkbook.Sheets(i).Name, vbTextCompare) = 0, xlSheetVeryHidden, xlSheetVisible) Ошибка: Нельзя установить свойство Visible класса Workshieet
Поищите у себя в коде - похоже, Вы пытаетесь скрыть последний видимый лист в книге. Возможно у Вас сначала ненужные листы скрываются, а затем нужные показываются и когда-нибудь наступает такой момент, когда в книге остается видимым один единственный лист и код должен его скрыть, что, конечно же, вызывает ошибку. Нужно наоборот - сначала показывать нужные листы, а затем скрывать ненужные. Тогда в файле всегда будет видимым хотя бы один лист.
Sheets(i).Visible = IIf(InStr(1, shs, ThisWorkbook.Sheets(i).Name, vbTextCompare) = 0, xlSheetVeryHidden, xlSheetVisible) Ошибка: Нельзя установить свойство Visible класса Workshieet
Поищите у себя в коде - похоже, Вы пытаетесь скрыть последний видимый лист в книге. Возможно у Вас сначала ненужные листы скрываются, а затем нужные показываются и когда-нибудь наступает такой момент, когда в книге остается видимым один единственный лист и код должен его скрыть, что, конечно же, вызывает ошибку. Нужно наоборот - сначала показывать нужные листы, а затем скрывать ненужные. Тогда в файле всегда будет видимым хотя бы один лист._Boroda_
_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]
_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
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]Побьют.
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
Сообщение отредактировал _Boroda_ - Четверг, 19.05.2016, 09:43
Похоже на то, что не оно. Где Вы там видите 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]
Похоже на то, что не оно. Где Вы там видите 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
А что же лист Антон3 делает? Чтобы не выдавало ошибку - нужно чтобы 1-й лист был "Старт"- тогда можете его назвать как угодно, или делать проверку названия листа Ваш файл в приложении
А что же лист Антон3 делает? Чтобы не выдавало ошибку - нужно чтобы 1-й лист был "Старт"- тогда можете его назвать как угодно, или делать проверку названия листа Ваш файл в приложенииSLAVICK