Excel это не сложно
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
29.03.2024, 14:13:51

Войти
Добавляйтесь в нашу группу ВКонтакте - будьте в курсе всех новых событий сайта, узнавайте первым обо всех акциях и новых статьях!
33 233 Сообщений в 5 454 Тем от 6 750 Пользователей
Последний пользователь: Alex1210
*
Перейти на сайт Хитрости Надстройка MulTEx Обучающие тренинги Наша группа ВКонтакте
Правила форума Начало Помощь Поиск Календарь Войти Регистрация Выйти
+  Excel это не сложно
|-+  Прочие форумы
| |-+  Заказы на написание макросов, работа для специалистов по Excel и VBA и пр.
| | |-+  Дописать код, чтобы назначить управление строками и столбцами
Страниц: [1]   Вниз
Печать
Автор Тема: Дописать код, чтобы назначить управление строками и столбцами  (Прочитано 5448 раз)
0 Пользователей и 1 Гость смотрят эту тему.
axlnik
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 3


Просмотр профиля E-mail
« : 30.03.2021, 14:32:05 »

Добрый день, взял код вот отсюда: https://www.excel-vba.ru/chto-umeet-excel/kazhdomu-polzovatelyu-svoj-listdiapazon/
пример: Tips_Macro_UsersRulesOnStart.xls (ПРАКТИЧЕСКИЙ ПРИМЕР С ИСПОЛЬЗОВАНИЕМ АДМИНИСТРАТОРА), нужно добавить код который позволит назначать пользователям состоящих в группе "user" строки или колонки как в примере Tips_Macro_Sheets_Hide_Rng_for_Users.xls (ДОСТУП К ОПРЕДЕЛЕННЫМ ЛИСТАМ И СКРЫТИЕ УКАЗАННЫХ СТРОК/СТОЛБЦОВ ) расположенный на той же странице. Мне удобно будет, если для этого будет использоваться [E] столбец
Код: (vb)
'---------------------------------------------------------------------------------------
' Module    : frmIndicateUser
' DateTime  : 11.05.2012 22:08
' Author    : The_Prist(Щербаков Дмитрий)
'             WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
'             http://www.excel-vba.ru
' Purpose   : http://www.excel-vba.ru/chto-umeet-excel/kazhdomu-polzovatelyu-svoj-listdiapazon/
'---------------------------------------------------------------------------------------
Option Explicit

Private Sub cmndbCancel_Click()
    Unload Me
'    ThisWorkbook.Close
End Sub

Private Sub cmndbOK_Click()
    Dim rFndRng As Range
    Dim avItems
    Dim lr As Long, li As Long
    Dim oSheet As Worksheet
    Dim sUserRange As String, sUserSheet As String, sSheets, s As String, ss As String
    Dim sGroupe As String
    Dim bShVis As Boolean

    Application.ScreenUpdating = 0
    With ThisWorkbook.Sheets(sUsersSH)
        li = .Cells(.Rows.Count, 1).End(xlUp).Row
        avItems = .Range(.Cells(2, 1), .Cells(li, 4)).Value
    End With
    If cmbUsers <> "" Then
        For lr = 1 To UBound(avItems, 1)
            s = LCase(avItems(lr, 1))
            sGroupe = avItems(lr, 4)
            If Len(s) Then
                If s = LCase(Me.cmbUsers.Value) Then
                    ss = avItems(lr, 2)
                    If Me.txtbKod = ss Then
                        'АДМИН
                        If sGroupe = "admin" Then
                            For Each oSheet In ThisWorkbook.Sheets
                                oSheet.Visible = -1
                            Next
                        Else
                            'ПОЛЬЗОВАТЕЛЬ
                            sUserSheet = avItems(lr, 3)
                            sSheets = Split(sUserSheet, ";")
                            For Each oSheet In ThisWorkbook.Sheets
                                If oSheet.Name <> sMainSheet Then oSheet.Visible = 2
                            Next
                            For Each oSheet In ThisWorkbook.Sheets
                                If oSheet.Name <> sUsersSH Then
                                    For li = 0 To UBound(sSheets)
                                        If oSheet.Name = sSheets(li) Then
                                            Sheets(sSheets(li)).Visible = -1
                                            bShVis = True
                                        End If
                                    Next li
                                End If
                            Next
                            If bShVis Then
                                Sheets(sSheets(0)).Activate
                                Sheets(sMainSheet).Visible = 2
                            Else
                                MsgBox "Для указанного пользователя нет листов для работы!", vbCritical, "Ошибка": Exit Sub
                            End If
                        End If
                    Else
                        MsgBox "Неверно указан код!", vbCritical, "Ошибка": Exit Sub
                    End If
                    Exit For
                End If
            End If
        Next lr
    Else
        MsgBox "Необходимо указать пользователя!", vbCritical, "Нет данных": Exit Sub
    End If

    bClose = False
    Application.ScreenUpdating = 1
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    Dim li As Long
    With ThisWorkbook.Sheets(sUsersSH)
        For li = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            cmbUsers.AddItem .Cells(li, 1)
        Next li
    End With
    bClose = True
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If bClose = True Then ThisWorkbook.Close True
End Sub
Записан
Страниц: [1]   Вверх
Печать
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2011, Simple Machines Valid XHTML 1.0! Valid CSS!
Яндекс.Метрика Рейтинг@Mail.ru