Добрый день уважаемые форумчане!!! Сегодня бухгалтерия обратилась за помощью. Можно ли сделать так чтоб один файл для одних отображал лишь те листы которые им нужны а другим лишь те которые другим нужны. И я вспомнил что как то в этой теме: My WebPage ТЕЗКА предложил вариант My WebPage
Цитата
Дата: Понедельник, 21.07.2014, 18:28 | Сообщение № 6
. Можно ли этот макрос переделать: [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) On Error GoTo 0 If Range("B2") <> p_ Then MsgBox "Неверный пароль": Exit Sub sk_ = ThisWorkbook.Sheets.Count sa_ = ActiveSheet.Name If Range("B1") = Лист4.Range("A2") Then For i = 1 To sk_ Sheets(i).Visible = xlSheetVisible Next i Else sn_ = Range("B1") Sheets(sn_).Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> sn_ Then Sheets(i).Visible = xlSheetVeryHidden Next i End If End Sub
[/vba] чтоб открывались вот такие листы: ШЕФ 111 и открываются все листы если Программисты 222 то открывается лишь лист загрузка в 1с
Добрый день уважаемые форумчане!!! Сегодня бухгалтерия обратилась за помощью. Можно ли сделать так чтоб один файл для одних отображал лишь те листы которые им нужны а другим лишь те которые другим нужны. И я вспомнил что как то в этой теме: My WebPage ТЕЗКА предложил вариант My WebPage
Цитата
Дата: Понедельник, 21.07.2014, 18:28 | Сообщение № 6
. Можно ли этот макрос переделать: [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) On Error GoTo 0 If Range("B2") <> p_ Then MsgBox "Неверный пароль": Exit Sub sk_ = ThisWorkbook.Sheets.Count sa_ = ActiveSheet.Name If Range("B1") = Лист4.Range("A2") Then For i = 1 To sk_ Sheets(i).Visible = xlSheetVisible Next i Else sn_ = Range("B1") Sheets(sn_).Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> sn_ Then Sheets(i).Visible = xlSheetVeryHidden Next i End If End Sub
[/vba] чтоб открывались вот такие листы: ШЕФ 111 и открываются все листы если Программисты 222 то открывается лишь лист загрузка в 1сlebensvoll
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) On Error GoTo 0 If Range("B2") <> p_ Then MsgBox "Неверный пароль": Exit Sub sk_ = ThisWorkbook.Sheets.Count sa_ = ActiveSheet.Name Application.ScreenUpdating = False
Select Case Range("B1") Case Лист4.Range("A2") 'Шеф For i = 1 To sk_ Sheets(i).Visible = xlSheetVisible Next i Case Лист4.Range("A3") 'Програмисты Лист11.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист11.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A4") 'Петров 'ля ля ля что-то для Петрова End Select Application.ScreenUpdating = True End Sub
[/vba]
[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) On Error GoTo 0 If Range("B2") <> p_ Then MsgBox "Неверный пароль": Exit Sub sk_ = ThisWorkbook.Sheets.Count sa_ = ActiveSheet.Name Application.ScreenUpdating = False
Select Case Range("B1") Case Лист4.Range("A2") 'Шеф For i = 1 To sk_ Sheets(i).Visible = xlSheetVisible Next i Case Лист4.Range("A3") 'Програмисты Лист11.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист11.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A4") 'Петров 'ля ля ля что-то для Петрова End Select Application.ScreenUpdating = True End Sub
devilkurs, столкнулся с трудностью (((( когда открываешь файл и выбираешь программисты вводишь пароль то (((((( увы(((( а вот если использовать сначала ШЕФ и пароль то все открывает и лишь потом если выбрать программисты и ввести пароль то он откроет то что нужно программиста (((( что то как то не то????
devilkurs, столкнулся с трудностью (((( когда открываешь файл и выбираешь программисты вводишь пароль то (((((( увы(((( а вот если использовать сначала ШЕФ и пароль то все открывает и лишь потом если выбрать программисты и ввести пароль то он откроет то что нужно программиста (((( что то как то не то????lebensvoll
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) On Error GoTo 0 If Range("B2") <> p_ Then MsgBox "Неверный пароль": Exit Sub sk_ = ThisWorkbook.Sheets.Count sa_ = ActiveSheet.Name Application.ScreenUpdating = False
Select Case Range("B1") Case Лист4.Range("A2") 'Шеф For i = 1 To sk_ Sheets(i).Visible = xlSheetVisible Next i Case Лист4.Range("A3") 'Програмисты Лист11.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист9.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A4") 'Анисимов 'нормы расхода Лист11.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист8.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i End Select Application.ScreenUpdating = True End Sub
[/vba]
[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) On Error GoTo 0 If Range("B2") <> p_ Then MsgBox "Неверный пароль": Exit Sub sk_ = ThisWorkbook.Sheets.Count sa_ = ActiveSheet.Name Application.ScreenUpdating = False
Select Case Range("B1") Case Лист4.Range("A2") 'Шеф For i = 1 To sk_ Sheets(i).Visible = xlSheetVisible Next i Case Лист4.Range("A3") 'Програмисты Лист11.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист9.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A4") 'Анисимов 'нормы расхода Лист11.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист8.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i End Select Application.ScreenUpdating = True End Sub
Все нашел свою ошибку )))) в одном месте указываю один лист в другом указываю другой (((( опять спешу и невнимательно отношусь к делу. ВСЕ РАБОТАЕТ СПАСИБО
Все нашел свою ошибку )))) в одном месте указываю один лист в другом указываю другой (((( опять спешу и невнимательно отношусь к делу. ВСЕ РАБОТАЕТ СПАСИБОlebensvoll
еще вариант, для каждого юзера нужно создать представление (я создал 2 - Старт и Программисты пароль на книгу - 123456
[vba]
Код
Sub scr(s$) ActiveWorkbook.Unprotect Лист4.[C1] ActiveWorkbook.CustomViews(s).Show ActiveWorkbook.Protect Лист4.[C1], True, False End Sub
[/vba]
[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) On Error GoTo 0 If Range("B2") <> p_ Then MsgBox "Неверный пароль": Exit Sub scr [b1] End Sub
[/vba]
[vba]
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean) scr "Старт" End Sub
Private Sub Workbook_Open() scr "Старт" End Sub
[/vba]
еще вариант, для каждого юзера нужно создать представление (я создал 2 - Старт и Программисты пароль на книгу - 123456
[vba]
Код
Sub scr(s$) ActiveWorkbook.Unprotect Лист4.[C1] ActiveWorkbook.CustomViews(s).Show ActiveWorkbook.Protect Лист4.[C1], True, False End Sub
[/vba]
[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) On Error GoTo 0 If Range("B2") <> p_ Then MsgBox "Неверный пароль": Exit Sub scr [b1] End Sub
[/vba]
[vba]
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean) scr "Старт" End Sub
devilkurs, krosav4ig, добрый день прошу вас помочь разобраться как добавлять юзера и открытие нужных для него листов!? [img][/img] [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) On Error GoTo 0 If Range("B2") <> p_ Then MsgBox "Неверный пароль": Exit Sub sk_ = ThisWorkbook.Sheets.Count sa_ = ActiveSheet.Name Application.ScreenUpdating = False
Select Case Range("B1") Case Лист4.Range("A2") 'Шеф For i = 1 To sk_ Sheets(i).Visible = xlSheetVisible Next i Case Лист4.Range("A3") 'Програмисты Лист9.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист9.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A4") 'Кузнецов 'нормы расхода Лист8.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист8.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A5") 'Железнов 'прайс калькулятор накладные цены транспорт приказ10 приказ11 прайс10 прайс11 прайс12 прайс01 прайс02 Лист7.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист7.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i End Select Application.ScreenUpdating = True End Sub
[/vba] чтоб для Железного открывался лист я понял как а как чтоб несколько листов я не могу разобраться
devilkurs, krosav4ig, добрый день прошу вас помочь разобраться как добавлять юзера и открытие нужных для него листов!? [img][/img] [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) On Error GoTo 0 If Range("B2") <> p_ Then MsgBox "Неверный пароль": Exit Sub sk_ = ThisWorkbook.Sheets.Count sa_ = ActiveSheet.Name Application.ScreenUpdating = False
Select Case Range("B1") Case Лист4.Range("A2") 'Шеф For i = 1 To sk_ Sheets(i).Visible = xlSheetVisible Next i Case Лист4.Range("A3") 'Програмисты Лист9.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист9.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A4") 'Кузнецов 'нормы расхода Лист8.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист8.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A5") 'Железнов 'прайс калькулятор накладные цены транспорт приказ10 приказ11 прайс10 прайс11 прайс12 прайс01 прайс02 Лист7.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист7.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i End Select Application.ScreenUpdating = True End Sub
[/vba] чтоб для Железного открывался лист я понял как а как чтоб несколько листов я не могу разобратьсяlebensvoll
Уважаемые форумчане помогите пожалуйста разобраться. Чтоб для для ЖЕЛЕЗНОГО открывались листы: прайс калькулятор накладные цены транспорт приказ10 приказ11 прайс10 прайс11 прайс12 прайс01 прайс02 [vba]
Код
Case Лист4.Range("A5") 'Железнов 'прайс калькулятор накладные цены транспорт приказ10 приказ11 прайс10 прайс11 прайс12 прайс01 прайс02 Лист7.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист7.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i
[/vba] или же мне каждый раз писать этот код для другого листа [vba]
Код
Case Лист4.Range("A5") 'Железнов 'прайс калькулятор накладные цены транспорт приказ10 приказ11 прайс10 прайс11 прайс12 прайс01 прайс02 Лист6.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист6.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i
[/vba]
Уважаемые форумчане помогите пожалуйста разобраться. Чтоб для для ЖЕЛЕЗНОГО открывались листы: прайс калькулятор накладные цены транспорт приказ10 приказ11 прайс10 прайс11 прайс12 прайс01 прайс02 [vba]
Код
Case Лист4.Range("A5") 'Железнов 'прайс калькулятор накладные цены транспорт приказ10 приказ11 прайс10 прайс11 прайс12 прайс01 прайс02 Лист7.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист7.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i
[/vba] или же мне каждый раз писать этот код для другого листа [vba]
Код
Case Лист4.Range("A5") 'Железнов 'прайс калькулятор накладные цены транспорт приказ10 приказ11 прайс10 прайс11 прайс12 прайс01 прайс02 Лист6.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист6.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i
если я вот так прописываю то он просто открывает лишь один лист Транспорт а другие нет ((((( [vba]
Код
Case Лист4.Range("A5") 'Железнов 'транспорт Лист7.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист7.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A5") 'Железнов 'цены Лист6.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист6.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A5") 'Железнов 'накладные Лист5.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист5.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A5") 'Железнов 'калькулятор Лист3.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист3.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A5") 'Железнов 'прайс Лист2.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист2.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i
[/vba]
если я вот так прописываю то он просто открывает лишь один лист Транспорт а другие нет ((((( [vba]
Код
Case Лист4.Range("A5") 'Железнов 'транспорт Лист7.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист7.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A5") 'Железнов 'цены Лист6.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист6.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A5") 'Железнов 'накладные Лист5.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист5.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A5") 'Железнов 'калькулятор Лист3.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист3.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A5") 'Железнов 'прайс Лист2.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист2.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i
Доброе утро всем!!! Уважаемые форумчане ну помогите пжл прописать данный код... Чтоб для оператора ЖЕЛЕЗНОГО открывались нужные ему листы ((((( я не могу понять как. Если я прописываю для него (Дата: Понедельник, 20.06.2016, 16:24 | Сообщение № 10) так вот, то получается что он открывает лишь лист "транспорт". А все остальные он не открывает (((((
Доброе утро всем!!! Уважаемые форумчане ну помогите пжл прописать данный код... Чтоб для оператора ЖЕЛЕЗНОГО открывались нужные ему листы ((((( я не могу понять как. Если я прописываю для него (Дата: Понедельник, 20.06.2016, 16:24 | Сообщение № 10) так вот, то получается что он открывает лишь лист "транспорт". А все остальные он не открывает (((((lebensvoll
RAN, согласен с вами полностью. Но чтоб их применить нужно понимать их прописывание. А с этим ((((( у меня проблемы. я прошел по ссылке чтоб воспользоваться вашим советом и : [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) On Error GoTo 0 If Range("B2") <> p_ Then MsgBox "Неверный пароль": Exit Sub sk_ = ThisWorkbook.Sheets.Count sa_ = ActiveSheet.Name Application.ScreenUpdating = False
Select Case Range("B1") Case Лист4.Range("A2") 'Шеф For i = 1 To sk_ Sheets(i).Visible = xlSheetVisible Next i Case Лист4.Range("A3") 'Програмисты Лист9.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист9.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A4") 'Кузнецов 'нормы расхода Лист8.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист8.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A5") 'Железнов 'листы For Each x In Array("Лист6 (Цены)", "Лист5 (Накладные)") Sheets(x).Visible = -1 Next End Select Application.ScreenUpdating = True End Sub
[/vba] что то так он и вовсе мне не отрыл листы ((((( в предыдущих постах у меня хоть один лист открывал для Железного а с этим нет (((((
RAN, согласен с вами полностью. Но чтоб их применить нужно понимать их прописывание. А с этим ((((( у меня проблемы. я прошел по ссылке чтоб воспользоваться вашим советом и : [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) On Error GoTo 0 If Range("B2") <> p_ Then MsgBox "Неверный пароль": Exit Sub sk_ = ThisWorkbook.Sheets.Count sa_ = ActiveSheet.Name Application.ScreenUpdating = False
Select Case Range("B1") Case Лист4.Range("A2") 'Шеф For i = 1 To sk_ Sheets(i).Visible = xlSheetVisible Next i Case Лист4.Range("A3") 'Програмисты Лист9.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист9.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A4") 'Кузнецов 'нормы расхода Лист8.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист8.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A5") 'Железнов 'листы For Each x In Array("Лист6 (Цены)", "Лист5 (Накладные)") Sheets(x).Visible = -1 Next End Select Application.ScreenUpdating = True End Sub
[/vba] что то так он и вовсе мне не отрыл листы ((((( в предыдущих постах у меня хоть один лист открывал для Железного а с этим нет (((((lebensvoll
SLAVICK, прошу вас помогите мне написать код вот смотрите если оператор ШЕФ использует данный документ он вбивает пароль 111 и для него открываются все листы, код: [vba]
Код
Case Лист4.Range("A2") 'Шеф For i = 1 To sk_ Sheets(i).Visible = xlSheetVisible Next i
[/vba] ПРАВИЛЬНО ведь!? Если данным документом пользуется программист то он использует свой пароль для пользования данным документом (к примеру пароль 222) и ему открывается лишь лист9 "Загрузка в 1С" [vba]
Код
Case Лист4.Range("A3") 'Програмисты Лист9.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист9.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i
[/vba] я добавил еще одного сотрудника и Кузнецова и присвоил ему пароль с открыванием листа "Нормы расхода" [vba]
Код
Case Лист4.Range("A4") 'Кузнецов 'нормы расхода Лист8.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист8.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i
[/vba] Я прекрасно понимаю что в данных кодах для программистов и кузнецова прописано лишь для открывания одного листа. А для шефа позволено пользование всех листов. Но, как сделать чтоб для добавленного сотрудника "ЖЕЛЕЗНОГО" открывались НЕСКОЛЬКО ЛИСТОВ!? Если я использую код как у "программистов и кузнецова" то он мне открывает лишь один ЛИСТ (((( и как добавить в этот код еще несколько листов не получается (((((. Я думал что можно несколько раз прописать для ЖЕЗНОГО этот код: [vba]
Код
Case Лист4.Range("A5") 'Железнов 'транспорт Лист7.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист7.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A5") 'Железнов 'цены Лист6.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист6.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i
[/vba] Но и тут меня ждало разочарование он мне открывает лишь первый заданный лист но ни как ни два ((((( и не могу сообразить что именно я должен вытянуть из этих постов предложенных вами и RAN, Не могли бы вы подправить мне код на несколько листов для сотрудника, а я потом по аналогии продолжу при писание. Если же вам это не сложно. Заранее вам спасибо огромное!!!
SLAVICK, прошу вас помогите мне написать код вот смотрите если оператор ШЕФ использует данный документ он вбивает пароль 111 и для него открываются все листы, код: [vba]
Код
Case Лист4.Range("A2") 'Шеф For i = 1 To sk_ Sheets(i).Visible = xlSheetVisible Next i
[/vba] ПРАВИЛЬНО ведь!? Если данным документом пользуется программист то он использует свой пароль для пользования данным документом (к примеру пароль 222) и ему открывается лишь лист9 "Загрузка в 1С" [vba]
Код
Case Лист4.Range("A3") 'Програмисты Лист9.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист9.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i
[/vba] я добавил еще одного сотрудника и Кузнецова и присвоил ему пароль с открыванием листа "Нормы расхода" [vba]
Код
Case Лист4.Range("A4") 'Кузнецов 'нормы расхода Лист8.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист8.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i
[/vba] Я прекрасно понимаю что в данных кодах для программистов и кузнецова прописано лишь для открывания одного листа. А для шефа позволено пользование всех листов. Но, как сделать чтоб для добавленного сотрудника "ЖЕЛЕЗНОГО" открывались НЕСКОЛЬКО ЛИСТОВ!? Если я использую код как у "программистов и кузнецова" то он мне открывает лишь один ЛИСТ (((( и как добавить в этот код еще несколько листов не получается (((((. Я думал что можно несколько раз прописать для ЖЕЗНОГО этот код: [vba]
Код
Case Лист4.Range("A5") 'Железнов 'транспорт Лист7.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист7.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i Case Лист4.Range("A5") 'Железнов 'цены Лист6.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист6.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i
[/vba] Но и тут меня ждало разочарование он мне открывает лишь первый заданный лист но ни как ни два ((((( и не могу сообразить что именно я должен вытянуть из этих постов предложенных вами и RAN, Не могли бы вы подправить мне код на несколько листов для сотрудника, а я потом по аналогии продолжу при писание. Если же вам это не сложно. Заранее вам спасибо огромное!!!lebensvoll
lebensvoll, Вы не правильно используете Select Case. Для каждого пользователя может быть только 1 case. Почитайте тут Попробуйте так: [vba]
Код
Case Лист4.Range("A5") 'Железнов 'транспорт Лист7.Visible = xlSheetVisible 'цены Лист6.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист6.Name And Sheets(i).Name <> Лист7.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i
[/vba]
lebensvoll, Вы не правильно используете Select Case. Для каждого пользователя может быть только 1 case. Почитайте тут Попробуйте так: [vba]
Код
Case Лист4.Range("A5") 'Железнов 'транспорт Лист7.Visible = xlSheetVisible 'цены Лист6.Visible = xlSheetVisible For i = 1 To sk_ If Sheets(i).Name <> Лист6.Name And Sheets(i).Name <> Лист7.Name And Sheets(i).Name <> Лист1.Name And _ Sheets(i).Visible <> xlSheetVeryHidden Then Sheets(i).Visible = xlSheetVeryHidden Next i
SLAVICK, да не нужно кричать то так (((( конечно же я смотрел и пост и даже пытался файл посмотреть и проанализировать но вот что получаю при разархивировании ((((( [img][/img] Manyasha, СПАСИБО ВАМ ОГРОМНОЕ!!! Я был близок к решению ))))) я пытался сначала сделать как то так ))) [vba]
Код
If Sheets(i).Name <> Лист6.Name And Sheets(i).Name <> Лист1.Name And _ If Sheets(i).Name <> Лист7.Name And Sheets(i).Name <> Лист1.Name And _ If Sheets(i).Name <> Лист8.Name And Sheets(i).Name <> Лист1.Name And _
[/vba] Но код потом ругался (((((( Пытался сделать и так ((((( [vba]
[/vba] но прописывал листы продолжал так вот )))) [vba]
Код
If Sheets(i).Name <> Лист6.Name And Sheets(i).Name <> Лист1.Name And _ If Sheets(i).Name <> Лист7.Name And Sheets(i).Name <> Лист1.Name And _ If Sheets(i).Name <> Лист8.Name And Sheets(i).Name <> Лист1.Name And _
[/vba] И тож не получалось (((((( т.е. сказать двигался я в правильном направлении но из-за не знания и не понимания в прописании кодов (((( я совершал ошибку. СПАСИБО ВСЕМ ОГРОМНОЕ....
SLAVICK, да не нужно кричать то так (((( конечно же я смотрел и пост и даже пытался файл посмотреть и проанализировать но вот что получаю при разархивировании ((((( [img][/img] Manyasha, СПАСИБО ВАМ ОГРОМНОЕ!!! Я был близок к решению ))))) я пытался сначала сделать как то так ))) [vba]
Код
If Sheets(i).Name <> Лист6.Name And Sheets(i).Name <> Лист1.Name And _ If Sheets(i).Name <> Лист7.Name And Sheets(i).Name <> Лист1.Name And _ If Sheets(i).Name <> Лист8.Name And Sheets(i).Name <> Лист1.Name And _
[/vba] Но код потом ругался (((((( Пытался сделать и так ((((( [vba]
[/vba] но прописывал листы продолжал так вот )))) [vba]
Код
If Sheets(i).Name <> Лист6.Name And Sheets(i).Name <> Лист1.Name And _ If Sheets(i).Name <> Лист7.Name And Sheets(i).Name <> Лист1.Name And _ If Sheets(i).Name <> Лист8.Name And Sheets(i).Name <> Лист1.Name And _
[/vba] И тож не получалось (((((( т.е. сказать двигался я в правильном направлении но из-за не знания и не понимания в прописании кодов (((( я совершал ошибку. СПАСИБО ВСЕМ ОГРОМНОЕ....lebensvoll
Кто бы ты ни был, мир в твоих руках
Сообщение отредактировал lebensvoll - Вторник, 21.06.2016, 13:40