'auto_open

 

Dim str As String

Dim name As String

Dim i As Integer

Dim j As Integer

Dim k As Integer

Dim row As Integer

Dim Role As String

Dim Staff As Integer

Dim tobo As Integer

Dim region As String

Dim a As Integer

 

i = 1

row = 11

 

str =
LCase(CreateObject("WScript.Network").UserName) 'Логін користвувача

Worksheets.Item("Basic").Cells(1, 1) = str

'MsgBox (str)

 

Do

    i = i + 1

    name =
LCase(Worksheets.Item("ListAccess").Cells(i, 3))

    

    

Loop Until name = str Or name = ""                      'Перевірка права доступу

 

    Role =
Worksheets.Item("ListAccess").Cells(i, 1)

    tobo =
Worksheets.Item("ListAccess").Cells(i, 5)

    Staff =
Worksheets.Item("ListAccess").Cells(i, 4)

    region =
Worksheets.Item("ListAccess").Cells(i, 6)

 

If Role = "SPECI" Then

 

    For j = 1 To
1500

        If Staff
= Worksheets.Item("Basic").Cells(j, 6) Then

           
Worksheets("Basic").Rows(j).Copy

           
Worksheets("Show").Rows(12).PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _

           
:=False, Transpose:=False

        End If

    Next j

   
ActiveWorkbook.Application.CutCopyMode = True 'Видаляю з буфера обміну копіювання ячеек

    

Else

 

   
ActiveWorkbook.Application.CutCopyMode = True 'Видаляю з буфера обміну копіювання ячеек

    MsgBox ("нет доступа ")

    Application.DisplayAlerts = False

    ActiveWorkbook.Close False

    

End If