تعیین دسترسی با استفاده از یوزر های Login ویندوز ، تعریف شده در شبکه و تعریف دسترسی بر اساس یوزر ها با محدودیت سلولی

**DOLFIN** · 2015/07/26, 16:42

سلام دوست عزیز
اگر چند نفر به طور همزمان از فایل استفاده نمی کنند یعنی ورک بوک SHARE نیست و فولدری که فایل اکسل درونش هست در شبکه SHARE است از این روش میشه استفاده کرد :
ستون هایی که می خواهید دیگران توانایی دسترسی داشته باشند رو انتخاب و از فرمت سل و از PROTECTION تیک LOCKED رو بردارید.
به قسمت ویژوال رفته و یک MODULE ایجاد کنید و این کد روی درونش قرار بدید :

کد:

Declare Function WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long

سپس در قسمت THISWORKBOOK این کد رو قرار بدید :

کد:

Private Sub Workbook_Open()
Const lpnLength As Integer = 255
      Dim status As Integer
      Dim lpName, lpUserName As String
      lpUserName = Space$(lpnLength + 1)
      status = WNetGetUser(lpName, lpUserName, lpnLength)
      If status = NoError Then
         lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
      Else
         MsgBox "Unable to get the name."
         End
      End If
If lpUserName = "ADMIN" Then
Sheet4.Unprotect ("123")
Else
Sheet4.Protect ("123")
End If
End Sub

جلوی IpuserName نام یوزری که می بایست دسترسی کلی داشته باشد را تایپ کنید.
به جای sheet4 شیت مورد نظر و به جای 123 پسورد شیت قفل شده را وارد کنید.

**sabertb** · 2015/07/26, 17:51

[QUOTE=DOLFIN;40122]سلام دوست عزیز
اگر چند نفر به طور همزمان از فایل استفاده نمی کنند یعنی ورک بوک SHARE نیست و فولدری که فایل اکسل درونش هست در شبکه SHARE است از این روش میشه استفاده کرد :
ستون هایی که می خواهید دیگران توانایی دسترسی داشته باشند رو انتخاب و از فرمت سل و از PROTECTION تیک LOCKED رو بردارید.
به قسمت ویژوال رفته و یک MODULE ایجاد کنید و این کد روی درونش قرار بدید :

کد:

Declare Function WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long

در مرحله اول این کد نویسی اشکال آفیس یا ویندوز 64 bit رو میگیره تصویر اشکال رو قرار میدم

در مورد قسمت دوم فرمول نویسی هم اینطور عمل کردم :

کد PHP:


Private Sub Workbook_Open()
Const lpnLength As Integer = 255
      Dim status As Integer
      Dim lpName, lpUserName As String
      lpUserName = Space$(lpnLength + 1)
      status = WNetGetUser(lpName, lpUserName, lpnLength)
      If status = NoError Then
         lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
      Else
         MsgBox "Unable to get the name."
         End
      End If
If lpUserName = "s.tabibi" Then
Sheet4.Unprotect ("12345")
Else
Sheet4.Protect ("12345")
End If
End Sub

پسورد هارو از 1 تا 5 ، و User name رو s.tabibi تغییر دادم .درسته ؟

**DOLFIN** · 2015/07/26, 18:56

سلام کد رو درMODULE به این شکل تغییر بدید :

کد:

Option Explicit
Declare Function WNetGetUser Lib "mpr.dll" _
                             Alias "WNetGetUserA" (ByVal lpName As String, _
                                                   ByVal lpUserName As String, lpnLength As Long) As Long

Const NoError = 0        'The Function call was successful

Public Function GetUserName() As String

' Buffer size for the return string.
Const lpnLength As Integer = 255

    ' Get return buffer space.
Dim status As Integer

    ' For getting user information.
Dim lpName, lpUserName As String

    ' Assign the buffer size constant to lpUserName.
    lpUserName = Space$(lpnLength + 1)

    ' Get the log-on name of the person using product.
    status = WNetGetUser(lpName, lpUserName, lpnLength)

    ' See whether error occurred.
    If status = NoError Then
        ' This line removes the null character. Strings in C are null-
        ' terminated. Strings in Visual Basic are not null-terminated.
        ' The null character must be removed from the C strings to be used
        ' cleanly in Visual Basic.
        lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
    Else
        ' An error occurred.
        GetUserName = "Unable to get the name."
        GoTo lbl_Exit
    End If

    ' Display the name of the person logged on to the machine.
    GetUserName = lpUserName
lbl_Exit:
    Exit Function
End Function

سپس در قسمت THISWORKBOOK این کد رو قرار بدید :

کد:

Private Sub Workbook_Open()
If GetUserName = "s.tabibi" Then
Sheet4.Unprotect ("12345")
Else
Sheet4.Protect ("12345")
End If
End Sub

**mokaram** · 2015/07/26, 20:16

برای حل مشکل اول ( ویندوز 64 بیتی ) کافیه که بعد از عبارت Declare کلمه Ptrsafe را مرقوم بفرمایید تا مشکلتون حل بشه

**sabertb** · 2015/07/27, 13:15

نوشته اصلی توسط DOLFIN

سلام کد رو درMODULE به این شکل تغییر بدید :

کد:

Option Explicit
Declare Function WNetGetUser Lib "mpr.dll" _
                             Alias "WNetGetUserA" (ByVal lpName As String, _
                                                   ByVal lpUserName As String, lpnLength As Long) As Long

Const NoError = 0        'The Function call was successful

Public Function GetUserName() As String

' Buffer size for the return string.
Const lpnLength As Integer = 255

    ' Get return buffer space.
Dim status As Integer

    ' For getting user information.
Dim lpName, lpUserName As String

    ' Assign the buffer size constant to lpUserName.
    lpUserName = Space$(lpnLength + 1)

    ' Get the log-on name of the person using product.
    status = WNetGetUser(lpName, lpUserName, lpnLength)

    ' See whether error occurred.
    If status = NoError Then
        ' This line removes the null character. Strings in C are null-
        ' terminated. Strings in Visual Basic are not null-terminated.
        ' The null character must be removed from the C strings to be used
        ' cleanly in Visual Basic.
        lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
    Else
        ' An error occurred.
        GetUserName = "Unable to get the name."
        GoTo lbl_Exit
    End If

    ' Display the name of the person logged on to the machine.
    GetUserName = lpUserName
lbl_Exit:
    Exit Function
End Function

سپس در قسمت THISWORKBOOK این کد رو قرار بدید :

کد:

Private Sub Workbook_Open()
If GetUserName = "s.tabibi" Then
Sheet4.Unprotect ("12345")
Else
Sheet4.Protect ("12345")
End If
End Sub

عالی شد ممنون هستم .

می تونم بپرسم اگر چند کاربر بخوام تعریف کنم که دسترسی کامل داشته باشند. و در مرحله Protect بخوام این امکانات رو داشته باشند .

کد PHP:


ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowSorting:=True, AllowFiltering:=True

چکار باید کنم ؟

**DOLFIN** · 2015/07/27, 15:06

به طور کلی در قسمت اول این کد نویسی یک تابع به نام GetUserName تعریف شده که شما میتونید حتی درون سلول شیت ها از آن استفاده کنید و این تابع نام یوزر ویندوزی که فایل اکسل را باز می کند را تایپ می کند.

در قسمت دوم این طور تعریف شده که اگر نام یوز ویندوز برایر با فلان بود شیت مورد نظر را که پسوردش 12345 است قفلش باز شود و اگر نبود قفل بماند.

پس برای اینکه ما بخواهیم دسترسی کامل را به چند یوزر ویندوز بدهیم باید قسمت دوم کدنویسی را تغییر دهیم و چون در قسمت دوم از if استفاده شده می توانیم با افزودن یک or تا چند شرط دلخواه دیگر هم اضافه کنیم.
برای مثلا سه یوزر کد را به این صورت تغییر می دهیم :

کد:

Private Sub Workbook_Open()
If GetUserName = "s.tabibi" or GetUserName="user2" or GetUserName="user3" Then
Sheet4.Unprotect ("12345")
Else
Sheet4.Protect ("12345")
End If
End Sub

**sabertb** · 2015/07/27, 15:49

نوشته اصلی توسط DOLFIN

به طور کلی در قسمت اول این کد نویسی یک تابع به نام GetUserName تعریف شده که شما میتونید حتی درون سلول شیت ها از آن استفاده کنید و این تابع نام یوزر ویندوزی که فایل اکسل را باز می کند را تایپ می کند.

در قسمت دوم این طور تعریف شده که اگر نام یوز ویندوز برایر با فلان بود شیت مورد نظر را که پسوردش 12345 است قفلش باز شود و اگر نبود قفل بماند.

پس برای اینکه ما بخواهیم دسترسی کامل را به چند یوزر ویندوز بدهیم باید قسمت دوم کدنویسی را تغییر دهیم و چون در قسمت دوم از if استفاده شده می توانیم با افزودن یک or تا چند شرط دلخواه دیگر هم اضافه کنیم.
برای مثلا سه یوزر کد را به این صورت تغییر می دهیم :

کد:

Private Sub Workbook_Open()
If GetUserName = "s.tabibi" or GetUserName="user2" or GetUserName="user3" Then
Sheet4.Unprotect ("12345")
Else
Sheet4.Protect ("12345")
End If
End Sub

قسمت آخر پرسش من هم اگه پاسخ بدید ممنون میشم . در قسمت Protect کردن برای افراد با محدودیت آنها بتوانند فیلتر کنند یا سورت کنند مانند همان کدای ضبط ماکرو ای که در پاسخ قبل نوشتم . ولینتونستم اونارو مستقیم تو کد نویسی شما وارد کنم . (Protect با قابلیت فیلترینگ و سورت)

**DOLFIN** · 2015/07/27, 16:14

در حالت PROTECT فیلتر انجام نمیشه می بایست یک command button ایجاد کنید و این کد رو براش تعریف کنید :

کد:

Private Sub CommandButton1_Click()
Sheet4.Unprotect ("12345")
ActiveSheet.AutoFilter.ApplyFilter
Sheet4.Protect ("12345")
End Sub

در این کد تنها فیلتر موجود برای ستون ها رفرش می شود اما می توانید با استفاده از کد یک فیلتر برای ستون خاص و با شرایط خاص ایجاد کنید.

**sabertb** · 2015/07/27, 16:27

نوشته اصلی توسط DOLFIN

در حالت PROTECT فیلتر انجام نمیشه می بایست یک command button ایجاد کنید و این کد رو براش تعریف کنید :

کد:

Private Sub CommandButton1_Click()
Sheet4.Unprotect ("12345")
ActiveSheet.AutoFilter.ApplyFilter
Sheet4.Protect ("12345")
End Sub

در این کد تنها فیلتر موجود برای ستون ها رفرش می شود اما می توانید با استفاده از کد یک فیلتر برای ستون خاص و با شرایط خاص ایجاد کنید.

درست می فرمایید . در اکسل انواع Protect کردن رو خودش داره که میشه با مشخص کردن گزینه های فیلتر و سورت جوری پروتکت کرد که سلول های locked شده قابل تغییر نباشند ولی قابل سورت و فیلتر باشند کد های این پروتکت هم با ضبط ماکرو مشخص میشه . حالا راهی هست که اون کد ها رو بشه داخل کد نویسی شما وارد کرد ؟ من وقتی داشتم سعی میکردم این دستورات رو وارد کنم در محیط VBA دیدم بعد از کد protect گزینه هاش موجوده بود ولی من نتونستم دستورش رو اونجور که باید و درست است وارد کنم در تصویر زیر مشخص میکنم کدوم قسمت رو میگم .

**DOLFIN** · 2015/07/27, 16:45

جواب شما در این تاپیک هست
فیلتر ستونهای شیت قفل شده

**sabertb** · 2015/07/27, 17:17

نوشته اصلی توسط DOLFIN

جواب شما در این تاپیک هست
فیلتر ستونهای شیت قفل شده

ممنون از پیگیری سریع تون خیلی خیلی متشکرم ولی این مورد به کارم نمیاد . دقیقا من می خوام همه سلول ها ، چه پروتکت شده چه نشده برای همه قابل فیلتر کردن و سورت کردن باشد. چون درسته دسترسی برای تغییرات برای بعضی از کاربران بسته و محدود است ولی آنها لازم دارند در صورت نیاز اطلاعات موجود رو فیلتر کنند . آیا در قسمتی که من تصویرشو قرار دادم نمی توان چنین دستوری قرار داد ؟ اون مواردی که خود VBA نشون میده مانند Allowsorting یا Allowfiltering برای چه منظور اونجا قرار دارند .
من تلاش کردم اونارو استفاده کنم به این تصویر توجه کنید . مشکل کجاست اصلا این قسمت قابل کار است ؟

اینجور که در اینترنت هم جستجو کردم می توان قسمت پروتکت کردن رو انجام داد با این فرض که فیلتر قابل اجرا باشد . ولی چگونه نمی دونم

فایل های پیوست شده

**DOLFIN** · 2015/07/27, 17:18

با استفاده از کد protect تا اونجایی که بنده میدونم شیت قفل شده رو نمیشه فیلتر کرد چون سطر ها بهم مربوطه تنها روش که به ذهنم می رسه این هست که برای هر ستون شما یک command button به شکلی که گفتم ایجاد کنید به طوری که هر کدام مربوط به یک ستون باشه .
البته ممکنه دوستان بتونن راه حل های بهتری رو پیشنهاد بدن . موفق باشید.

**sabertb** · 2015/07/27, 17:32

نوشته اصلی توسط DOLFIN

با استفاده از کد protect تا اونجایی که بنده میدونم شیت قفل شده رو نمیشه فیلتر کرد چون سطر ها بهم مربوطه تنها روش که به ذهنم می رسه این هست که برای هر ستون شما یک command button به شکلی که گفتم ایجاد کنید به طوری که هر کدام مربوط به یک ستون باشه .
البته ممکنه دوستان بتونن راه حل های بهتری رو پیشنهاد بدن . موفق باشید.

دستتون درد نکنه فوقالعاده کمکم کردید . من تونستم اشکال اون کد نویسی رو حل کنم ولی همینطور که شما گفتید فعلا که کاری از پیش نبردم .
هنوز فیلترینگش غیر فعاله در حالت پروتکت !

دوستان یه کمک برسونید 95% کار رو ، استاد "Dolfin" انجام دادن فقط مونده اون نفرات با دسترسی محدود بتونن فیلتر رو انجام بدند بدون command button (علت اصرار من هم اینه که افرادی که قراره استفاده کنند از این فایل اصلا قبول نمیکنند که روش کارشون رو تغییر بدند .یه command button اضافه بشه میگن ما نمی تونیم و از این حرفا ...

**sabertb** · 2015/07/27, 18:25

بلا خره موفق شدم این کارو انجام بدم با کمک استاد عزیز

کد PHP:


Option Explicit
Declare PtrSafe Function WNetGetUser Lib "mpr.dll" _
                             Alias "WNetGetUserA" (ByVal lpName As String, _
                                                   ByVal lpUserName As String, lpnLength As Long) As Long

Const NoError = 0        'The Function call was successful

Public Function GetUserName() As String

' Buffer size for the return string.
Const lpnLength As Integer = 255

    ' Get return buffer space.
Dim status As Integer

    ' For getting user information.
Dim lpName, lpUserName As String

    ' Assign the buffer size constant to lpUserName.
    lpUserName = Space$(lpnLength + 1)

    ' Get the log-on name of the person using product.
    status = WNetGetUser(lpName, lpUserName, lpnLength)

    ' See whether error occurred.
    If status = NoError Then
        ' This line removes the null character. Strings in C are null-
        ' terminated. Strings in Visual Basic are not null-terminated.
        ' The null character must be removed from the C strings to be used
        ' cleanly in Visual Basic.
        lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
    Else
        ' An error occurred.
        GetUserName = "Unable to get the name."
        GoTo lbl_Exit
    End If

    ' Display the name of the person logged on to the machine.
    GetUserName = lpUserName
lbl_Exit:
    Exit Function
End Function

و در thisworkbook

کد PHP:


Private Sub Workbook_Open()
If GetUserName = "s.tabibi" Or GetUserName = "a.alijanzadeh" Or GetUserName = "a.namdari" Then
Sheet2.Unprotect ("132025")
Sheet3.Unprotect ("132025")
Else
Sheet2.Protect Contents:=True, Scenarios:=True, Password:=132025, AllowSorting:=True, AllowFiltering:=True
Sheet3.Protect Contents:=True, Scenarios:=True, Password:=132025, AllowSorting:=True, AllowFiltering:=True
End If
End Sub

یه سوال جدید دارم حالا اگر تعداد صفحات زیاد بود چه کار کنیم نمیشه کاری کرد که کلا همه sheet ها این قالب برایشان حکم فرما باشد ؟

تعیین دسترسی با استفاده از یوزر های Login ویندوز ، تعریف شده در شبکه و تعریف دسترسی بر اساس یوزر ها با محدودیت سلولی

تعیین دسترسی با استفاده از یوزر های Login ویندوز ، تعریف شده در شبکه و تعریف دسترسی بر اساس یوزر ها با محدودیت سلولی

کامنت

کامنت

کامنت

کامنت

کامنت

کامنت

کامنت

کامنت

کامنت

کامنت

کامنت

کامنت

کامنت

کامنت