تغییر اطلاعات

majid_mx4 · 2020/04/06, 12:33

با سلام

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

بعد آن شیتها را جابجا کنید شیت مثلا شیت اول را بجای شیت 4 و شیت دوم را به جای شیت اول ببرید.
حال ازکد خود استفاده کنید. و نام شیت ها را با نامهای نوشته شده توسط خودتان در A3 مقایسه کنید.

و نتیجه را اعلام کنید.

موفق باشید میر

میثم مقدم نیا · 2020/04/06, 07:16

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

با سلام
پایه شماره ردیفها دستور زیر است که شروع به شمارش تعداد ردیف ها در ستون A میکند. و میگویم برای هر ردیف تا آخرین ردیف

کد:

For Each Cell In Sheets("User List").Range("A2:A" & Sheets("User List").Range("A65536").End(xlUp).Row)

و با این کد میگیم که اگر آن ردیف مساوی بودچکاری انجام شود چون اطلاعات مورد نظر ما در ستون دو م آن قرار دارد پس از offset استفاده میکنم و میگویم دومین خانه بعد از
ردیف اول یعنی ردیف اول از نظر شمارشی صفر در نظر گرفته میشود.

کد:

If UCase(Cell.Offset(, 2).Value) = UCase(UserName) And UCase(Cell.Offset(, 1).Value) = UCase(Password) Then

این پاسخ شما لطفا شما هم به پرسش بنده در پست قبلی پاسخ دهید.(بنده دوبار اخطار......)

موفق باشید میر

سلام استاد
من چک کردم تغیر تام هم دادم مشکلی وجود نداشت ولی نظر به احترام شما من کد را غیر فعال کردم

- - - Updated - - -

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

با سلام
پایه شماره ردیفها دستور زیر است که شروع به شمارش تعداد ردیف ها در ستون A میکند. و میگویم برای هر ردیف تا آخرین ردیف

کد:

For Each Cell In Sheets("User List").Range("A2:A" & Sheets("User List").Range("A65536").End(xlUp).Row)

و با این کد میگیم که اگر آن ردیف مساوی بودچکاری انجام شود چون اطلاعات مورد نظر ما در ستون دو م آن قرار دارد پس از offset استفاده میکنم و میگویم دومین خانه بعد از
ردیف اول یعنی ردیف اول از نظر شمارشی صفر در نظر گرفته میشود.

کد:

If UCase(Cell.Offset(, 2).Value) = UCase(UserName) And UCase(Cell.Offset(, 1).Value) = UCase(Password) Then

این پاسخ شما لطفا شما هم به پرسش بنده در پست قبلی پاسخ دهید.(بنده دوبار اخطار......)

موفق باشید میر

سلام استاد
من چک کردم تغیر نام هم دادم مشکلی وجود نداشت ولی نظر به احترام شما من کد را غیر فعال کردم

majid_mx4 · 2020/04/06, 01:05

با سلام
پایه شماره ردیفها دستور زیر است که شروع به شمارش تعداد ردیف ها در ستون A میکند. و میگویم برای هر ردیف تا آخرین ردیف

کد:

For Each Cell In Sheets("User List").Range("A2:A" & Sheets("User List").Range("A65536").End(xlUp).Row)

و با این کد میگیم که اگر آن ردیف مساوی بودچکاری انجام شود چون اطلاعات مورد نظر ما در ستون دو م آن قرار دارد پس از offset استفاده میکنم و میگویم دومین خانه بعد از
ردیف اول یعنی ردیف اول از نظر شمارشی صفر در نظر گرفته میشود.

کد:

If UCase(Cell.Offset(, 2).Value) = UCase(UserName) And UCase(Cell.Offset(, 1).Value) = UCase(Password) Then

این پاسخ شما لطفا شما هم به پرسش بنده در پست قبلی پاسخ دهید.(بنده دوبار اخطار......)

موفق باشید میر

Meysam6335 · 2020/04/04, 17:38

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

با سلام

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

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

کد:

Private Sub CommandButton1_Click()

'Variant
Dim Sh As Worksheet
Dim UserName As String
Dim Password As String
Dim Cell As Range
Dim c As Long
If Val(TextBox2.Text) <> Val(TextBox3.Text) Then
    MsgBox "تکرار رمز همخواني ندارند"
    Exit Sub
End If

'UserName = TextBox4.Text
UserName = ActiveSheet.Name
Password = CStr(TextBox1.Text)
For Each Cell In Sheets("User List").Range("A2:A" & Sheets("User List").Range("A65536").End(xlUp).Row)
If UCase(Cell.Offset(, 2).Value) = UCase(UserName) And UCase(Cell.Offset(, 1).Value) = UCase(Password) Then
' Cell.Value = Val(TextBox4.Text)
    Cell.Offset(0, 1) = CStr(TextBox2.Text)
 MsgBox "تغيير رمز انجام شد"
   
 Exit Sub
End If
Next Cell
MsgBox " رمز يا نام کاربري وارد شده صحيح نمي باشد"

Exit Sub

End Sub

موفق باشید میر

سلام
عالی بود فقط یچیزی را من تو این کد متوجه نمیشم ممنون میشم که راهنمایم کنید
تو این کد ما ستون B را تغییر میدیم ولی من متوجه نشدم که از کجا ستون B انتخاب شده که احیانا اگه پسورد من تو ستون A یا C بود اون را جایگزین کنم
یا به عبارت دیگه بخوام یوزر نیم را تغییر بدم
باید در این کد تغییر ایجاد کنم

کد PHP:


If UCase(Cell.Offset(, 2).Value) = UCase(UserName) And UCase(Cell.Offset(, 1).Value) = UCase(Password) Then

majid_mx4 · 2020/04/04, 13:56

با سلام

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

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

کد:

Private Sub CommandButton1_Click()

'Variant
Dim Sh As Worksheet
Dim UserName As String
Dim Password As String
Dim Cell As Range
Dim c As Long
If Val(TextBox2.Text) <> Val(TextBox3.Text) Then
    MsgBox "تکرار رمز همخواني ندارند"
    Exit Sub
End If

'UserName = TextBox4.Text
UserName = ActiveSheet.Name
Password = CStr(TextBox1.Text)
For Each Cell In Sheets("User List").Range("A2:A" & Sheets("User List").Range("A65536").End(xlUp).Row)
If UCase(Cell.Offset(, 2).Value) = UCase(UserName) And UCase(Cell.Offset(, 1).Value) = UCase(Password) Then
' Cell.Value = Val(TextBox4.Text)
    Cell.Offset(0, 1) = CStr(TextBox2.Text)
 MsgBox "تغيير رمز انجام شد"
   
 Exit Sub
End If
Next Cell
MsgBox " رمز يا نام کاربري وارد شده صحيح نمي باشد"

Exit Sub

End Sub

موفق باشید میر

Meysam6335 · 2020/04/04, 13:22

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

بسیار خرسندم که مشکل شما حل شده ولی هشدار داده شده دراین پست را نیز در نظر بگیرید

تن درست باشید میر

سلام

ممنون از فایل زیباتون

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

مشکل اینجاست که وقتی تغییر پسورد را تا زمانی که از عدد استفاده میکنم میدم همه چیز عادی هستش

ولی هنگامی که برای مثال میخوام پسور کاربر اول (احمد امینی را از 1 به Ahmad تغییر بدم خطا میده

خطا هم به این علت هست که وقتی رمز عبور قبلی 1 رو به Ahmad تغیییر میدم در شیت User List رمزعبور احمد یا برابر 0 میشه کاربرای دیگه هم همچنین

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

Pass_007.xls (88.0 کیلو بایت, مشاهدات 5)

majid_mx4 · 2020/04/04, 00:54

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

با سلام
کد تغییر نام شیت را چک نکردم ولی از دستورات نوشته شده احتمالا اینکار انجام نمی شود.

یا اگر هم انجام شود از روی شماره شیت است و نه نام آن باز هم می گویم بنده کد شما را چک نکردم بهتر است برای امتحان در یکی از خانه های آنها شماره گذاری کنید و سپس یکی از شیت ها را جابجا کنید و شیت جابجا شده را تغییر نام دهید اگر شماره شیت ها با نام آنها درست درآمد حتما درست است ولی بنده بعید می دونم .
احتمال این کد باعث جابجایی اطلاعات در شیت یعنی تغییر اطلاعات یک کاربر برای کاربر دیگر میشود.
پایدار باشید میر

بسیار خرسندم که مشکل شما حل شده ولی هشدار داده شده دراین پست را نیز در نظر بگیرید

تن درست باشید میر

iranweld · 2020/04/03, 22:23

با سلام

در تکمیل فرمایشات استاد بزرگوارم majid_mx4 فایل پیوست را بررسی کنید.

در صورت ورود با admin تمام شیت ها قابل دستیابی بوده و در صورت ورود کاربران فقط همان شیت کاربر قابل مشاهده خواهد بود

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

Pass_003.xls (92.5 کیلو بایت, مشاهدات 10)

Meysam6335 · 2020/04/03, 22:15

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

با سلام

لطفا 2 کد زیر را به جایگزین کد قبلی کنید.

کد:

Private Sub CommandButton1_Click()


Dim Sh As Worksheet
Dim UserName As String
Dim Password As String
Dim Cell As Range
Dim c As Long
If Val(TextBox2.Text) <> Val(TextBox3.Text) Then
    MsgBox "تکرار رمز همخواني ندارند"
    Exit Sub
End If

UserName = TextBox4.Text
Password = Val(TextBox1.Text)
For Each Cell In Sheets("User List").Range("A2:A" & Sheets("User List").Range("A65536").End(xlUp).Row)
If UCase(Cell.Offset(, 2).Value) = UCase(UserName) And UCase(Cell.Offset(, 1).Value) = UCase(Password) Then
' Cell.Value = Val(TextBox4.Text)
    Cell.Offset(0, 1) = Val(TextBox2.Text)
 MsgBox "تغيير رمز انجام شد"
   
 Exit Sub
End If
Next Cell
MsgBox " رمز يا نام کاربري وارد شده صحيح نمي باشد"

            Exit Sub

End Sub

کد:

Private Sub UserForm_Activate()
TextBox4.Text = ActiveSheet.Name
End Sub

پایدار باشید میر

با سلام مجدد
ممنون استاد عالی با یه تغییر کوچلودر کد شما به نتیجه دل خواه رسیدم

کد PHP:

Private Sub CommandButton1_Click() Dim Sh As Worksheet Dim UserName As String Dim Password As String Dim Cell As Range Dim c As Long If Val(TextBox2.Text) <> Val(TextBox3.Text) Then MsgBox "تکرار رمز همخواني ندارند" Exit Sub End If 'UserName = TextBox4.Text UserName = ActiveSheet.Name Password = Val(TextBox1.Text) For Each Cell In Sheets("User List").Range("A2:A" & Sheets("User List").Range("A65536").End(xlUp).Row) If UCase(Cell.Offset(, 2).Value) = UCase(UserName) And UCase(Cell.Offset(, 1).Value) = UCase(Password) Then ' Cell.Value = Val(TextBox4.Text) Cell.Offset(0, 1) = Val(TextBox2.Text) MsgBox "تغيير رمز انجام شد" Exit Sub End If Next Cell MsgBox " رمز يا نام کاربري وارد شده صحيح نمي باشد" Exit Sub End Sub

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

Pass_004.xls (94.0 کیلو بایت, مشاهدات 6)

majid_mx4 · 2020/04/03, 20:54

با سلام
کد تغییر نام شیت را چک نکردم ولی از دستورات نوشته شده احتمالا اینکار انجام نمی شود.

یا اگر هم انجام شود از روی شماره شیت است و نه نام آن باز هم می گویم بنده کد شما را چک نکردم بهتر است برای امتحان در یکی از خانه های آنها شماره گذاری کنید و سپس یکی از شیت ها را جابجا کنید و شیت جابجا شده را تغییر نام دهید اگر شماره شیت ها با نام آنها درست درآمد حتما درست است ولی بنده بعید می دونم .
احتمال این کد باعث جابجایی اطلاعات در شیت یعنی تغییر اطلاعات یک کاربر برای کاربر دیگر میشود.
پایدار باشید میر

majid_mx4 · 2020/04/03, 20:28

با سلام

لطفا 2 کد زیر را به جایگزین کد قبلی کنید.

کد:

Private Sub CommandButton1_Click()


Dim Sh As Worksheet
Dim UserName As String
Dim Password As String
Dim Cell As Range
Dim c As Long
If Val(TextBox2.Text) <> Val(TextBox3.Text) Then
    MsgBox "تکرار رمز همخواني ندارند"
    Exit Sub
End If

UserName = TextBox4.Text
Password = Val(TextBox1.Text)
For Each Cell In Sheets("User List").Range("A2:A" & Sheets("User List").Range("A65536").End(xlUp).Row)
If UCase(Cell.Offset(, 2).Value) = UCase(UserName) And UCase(Cell.Offset(, 1).Value) = UCase(Password) Then
' Cell.Value = Val(TextBox4.Text)
    Cell.Offset(0, 1) = Val(TextBox2.Text)
 MsgBox "تغيير رمز انجام شد"
   
 Exit Sub
End If
Next Cell
MsgBox " رمز يا نام کاربري وارد شده صحيح نمي باشد"

            Exit Sub

End Sub

کد:

Private Sub UserForm_Activate()
TextBox4.Text = ActiveSheet.Name
End Sub

پایدار باشید میر

Meysam6335 · 2020/04/03, 19:49

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

با سلام
لطفا کد زیر را جایگزین کد قبلی کنید.

کد:

Private Sub CommandButton2_Click()

Dim UserName As String
Dim Password As String
Dim Cell As Range

If Val(TextBox2.Text) <> Val(TextBox3.Text) Then
    MsgBox "تکرار رمز همخواني ندارند"
    Exit Sub
End If

UserName = Val(TextBox4.Text)
Password = Val(TextBox1.Text)
' نام شيت پسوردها ("User List") کد
For Each Cell In Sheets("User List").Range("A2:A" & Sheets("User List").Range("A65536").End(xlUp).Row)
If UCase(Cell.Offset(, 1).Value) = UCase(Password) Then
    Cell.Offset(0, 1) = Val(TextBox2.Text)
 MsgBox "تغيير رمز انجام شد"
  
 Exit Sub
End If
Next Cell
MsgBox " رمز يا نام کاربري وارد شده صحيح نمي باشد"

Exit Sub
End Sub

موفق باشید میر

با سلام مجدد
ممنون استاد عالی بود تکس باکس نام کاربری حذف شد
ولی به گمونم من نتونستم خوب منظورم را بیان کنم
تو این کد شما هر کاربری اگه یوزر نیم پسورد کس دیگه را داشته باشه راحت میتونه اون را تغیر بده فرقی نمی کنه که کاربر 1 یا دو یا3...
من میخوام که شرط برای تغییر رمزعبور ملاک با برابر بودن نام شیت فعال با Book Name در شیت رمز عبور(User List) باشه
یعنی اگر در شیت Ahmad Amini بودم بره تو Book Name و ردیف احمد امینی را پیدا کنه و در صورت مطابقت رمز عبور قبلی رمز عبور جدید جایگزین بشه
امید وارم منظورم را درست رسونده باشم و اینقدر شما را به ضخمت نندازم.
یه نکته ای را بگم با کدی که در شیت User List هست با تغییر هریک از نام های Book Name نام شیت ها هم تغییر میکنه

کد PHP:

Private Sub Worksheet_Change(ByVal Target As Range) Dim lCount As Long If Target.Cells.Count > 1 Then Exit Sub On Error Resume Next If Not Intersect(Target, Range("C1:C5")) Is Nothing Then For lCount = 1 To Sheets.Count If Sheets(lCount).Name <> Me.Name Then Sheets(lCount).Name = Me.Cells(lCount, "C") End If Next lCount End If End Sub

majid_mx4 · 2020/04/03, 16:09

با سلام
لطفا کد زیر را جایگزین کد قبلی کنید.

کد:

Private Sub CommandButton2_Click()

Dim UserName As String
Dim Password As String
Dim Cell As Range

If Val(TextBox2.Text) <> Val(TextBox3.Text) Then
    MsgBox "تکرار رمز همخواني ندارند"
    Exit Sub
End If

UserName = Val(TextBox4.Text)
Password = Val(TextBox1.Text)
' نام شيت پسوردها ("User List") کد
For Each Cell In Sheets("User List").Range("A2:A" & Sheets("User List").Range("A65536").End(xlUp).Row)
If UCase(Cell.Offset(, 1).Value) = UCase(Password) Then
    Cell.Offset(0, 1) = Val(TextBox2.Text)
 MsgBox "تغيير رمز انجام شد"
  
 Exit Sub
End If
Next Cell
MsgBox " رمز يا نام کاربري وارد شده صحيح نمي باشد"

Exit Sub
End Sub

موفق باشید میر

Meysam6335 · 2020/04/03, 12:11

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

با سلام

با عرض پوزش بخاطر اشتباه رخ داده لطفا دستورات زیر را جایگزین دستورات قبلی کنید.

کد:

Private Sub CommandButton3_Click()

Dim Sh As Worksheet
Dim UserName As String
Dim Password As String
Dim Cell As Range
Dim c As Long
If Val(TextBox2.Text) <> Val(TextBox3.Text) Then
    MsgBox "تکرار رمز همخواني ندارند"
    Exit Sub
End If

UserName = Val(TextBox4.Text)
Password = Val(TextBox1.Text)
For Each Cell In Sheets("User List").Range("A2:A" & Sheets("User List").Range("A65536").End(xlUp).Row)
If UCase(Cell.Value) = UCase(UserName) And UCase(Cell.Offset(, 1).Value) = UCase(Password) Then
 Cell.Value = Val(TextBox4.Text)
    Cell.Offset(0, 1) = Val(TextBox2.Text)
 MsgBox "تغيير رمز انجام شد"
   
 Exit Sub
End If
Next Cell
MsgBox " رمز يا نام کاربري وارد شده صحيح نمي باشد"

            Exit Sub
End Sub

سلامت باشید میر

با سلام مجدد
ممنون از کد زیباتون و وقتی که برای بنده گذاشتین
اگه بجای وارد کردن نام کاربری خودش نام شیت را میگرفت و اون قسمت نام کاربری حذف میشود به نظر من بهتر و یوزرفرم خلوتر میشود
چون در قسمت پسورها یک سطون به نام Book Name هست که اسم شیت ها در اونجا هست من تو فایل پیوست قبلی یادم رفته بود که اون را اضافه کنم در فایل پیوست جدید اونها را قرار دادم
ممنون میشم کمکم کنید
بازم از شما پوزش میطلبم که وقت گران بهای شما را گرفتم

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

Pass_003.xls (70.0 کیلو بایت, مشاهدات 4)

majid_mx4 · 2020/04/03, 03:24

با سلام

با عرض پوزش بخاطر اشتباه رخ داده لطفا دستورات زیر را جایگزین دستورات قبلی کنید.

کد:

Private Sub CommandButton3_Click()

Dim Sh As Worksheet
Dim UserName As String
Dim Password As String
Dim Cell As Range
Dim c As Long
If Val(TextBox2.Text) <> Val(TextBox3.Text) Then
    MsgBox "تکرار رمز همخواني ندارند"
    Exit Sub
End If

UserName = Val(TextBox4.Text)
Password = Val(TextBox1.Text)
For Each Cell In Sheets("User List").Range("A2:A" & Sheets("User List").Range("A65536").End(xlUp).Row)
If UCase(Cell.Value) = UCase(UserName) And UCase(Cell.Offset(, 1).Value) = UCase(Password) Then
 Cell.Value = Val(TextBox4.Text)
    Cell.Offset(0, 1) = Val(TextBox2.Text)
 MsgBox "تغيير رمز انجام شد"
   
 Exit Sub
End If
Next Cell
MsgBox " رمز يا نام کاربري وارد شده صحيح نمي باشد"

            Exit Sub
End Sub

سلامت باشید میر