تعمیم دادن دستور زیر برای همه صفحات موجود در فایل و صفحات جدید ایجاد شده.

Collapse
X
 
  • زمان
  • نمایش
حذف همه
new posts
  • sabertb

    • 2014/04/09
    • 347
    • 45.00

    تعمیم دادن دستور زیر برای همه صفحات موجود در فایل و صفحات جدید ایجاد شده.

    سلام دوستان در پرسشی دیگر من این راه حل خوب رو از استاد Dolfin یاد گرفتم . حالا می خوام این دستور رو جوری تغییر بدم که وابسته به شماره Sheet ها نباشه و کلا هرچی تو فایل هست رو شامل شود .
    یه سوال دیگه هم دارم با توجه به این که این کد نویسی مخصوص ویندوز 64 بیتی است اگر کسی با ویندوز 32 بیتی این فایل رو اجرا کند احتمالا جواب میدهد یا نه ؟؟ اگر نمی دهد چه کار میشود کرد ؟

    کد PHP:
    Option Explicit
    Declare PtrSafe Function WNetGetUser Lib "mpr.dll" _
                                 Alias 
    "WNetGetUserA" (ByVal lpName As String_
                                                       ByVal lpUserName 
    As StringlpnLength 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 lpNamelpUserName 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(lpNamelpUserNamelpnLength)

        
    ' See whether error occurred.
        If status = NoError Then
            ' 
    This line removes the null characterStrings 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 
    کد PHP:
    Private Sub Workbook_Open()
    If 
    GetUserName "s.tabibi" Or GetUserName "a.alijanzadeh" Then
    Sheet2
    .Unprotect ("132025")
    Sheet3.Unprotect ("132025")
    Else
    Sheet2.Protect Contents:=TrueScenarios:=TruePassword:=132025AllowSorting:=TrueAllowFiltering:=True
    Sheet3
    .Protect Contents:=TrueScenarios:=TruePassword:=132025AllowSorting:=TrueAllowFiltering:=True
    End 
    If
    End Sub 
    دسترسی محدود با استفاده از Usename های لوگین شده در ویندوز (محدود از نظر تغییر دادن ولی قابل فیلتر و سورت کردن می باشد)
    یوزر های وارد شده بالا یوزر هایی هستن که دسترسی کامل دارند .
    :min10::min18::min13::min22:
  • DOLFIN

    • 2014/01/18
    • 149

    #2
    سلام در جواب سوال اول برای اینکه کد شما شامل تمام شیت های موجود بشه باید از دستور for به این شکل استفاده کنید :
    کد:
    Private Sub Workbook_Open()
    Dim ws As Worksheet
    If GetUserName = "s.tabibi" Or GetUserName = "a.alijanzadeh" Then
    For Each ws In Worksheets
    ws.Unprotect ("132025")
    Next ws
    Else
    For Each ws In Worksheets
    ws.Protect Contents:=True, Scenarios:=True, Password:=132025, AllowSorting:=True, AllowFiltering:=True
    Next ws
    End If
    End Sub
    در جواب سوال دوم هم چون کد به صورت یک تابع تعریف شده در ویندوز های 32 و 64 مشکلی ایجاد نمیشه .
    [CENTER][FONT=times new roman][SIZE=7][I][B][COLOR=#0000ff] خانه اکسل - [url]http://excelhouse.blog.ir[/url][/COLOR][/B][/I][/SIZE]
    [/FONT][/CENTER]

    کامنت

    چند لحظه..