Coba script untuk event click tombol ganti berikut :
Dim rngNama As Range
Dim sTemp As String, sMsg As String
With Sheet1
'cek input nama
sTemp = Trim$(.nama.Text)
If LenB(sTemp) = 0 Then
sMsg = "Nama masih kosong"
GoTo Keluar
End If
Set rngNama = Sheet2.Range("a1").CurrentRegion.Resize(, 1).Find(sTemp, lookat:=xlWhole, MatchCase:=True)
If rngNama Is Nothing Then
sMsg = "Tidak ada nama : " & sTemp
GoTo Keluar
End If
'cek pass lama
sTemp = .passlama.Text
If LenB(sTemp) = 0 Then
sMsg = "Isi password lama lebih dulu."
GoTo Keluar
ElseIf InStr(sTemp, rngNama.Offset(, 1).Value) <> 1 Then
sMsg = "Password lama tidak sesuai."
GoTo Keluar
End If
'cek pass baru dan ulang pass baru
sTemp = .passbaru.Text
'jika minimal karakter password adalah 4, ganti = 0 dengan = 8 atau
'ganti baris If lenb(stemp)=0 then dengan if len(stemp)=4 then
If LenB(sTemp) = 0 Then
sMsg = "Isi passsword baru dan ulangi pengisian di re pass baru."
GoTo Keluar
ElseIf InStr(sTemp, .ulangpassbaru.Text) <> 1 Then
sMsg = "Password baru berbeda dengan re pass baru."
GoTo Keluar
End If
'setelah semua trap, maka sampai sini pass baru bisa diisikan
rngNama.Offset(, 1).Value = sTemp 'password
rngNama.Offset(, 2).Value = rngNama.Value & " " & sTemp 'nama password
'set pesan sukses
sMsg = "Password anda telah diganti."
Keluar:
'clean area input
.nama.Text = vbNullString
.passlama.Text = vbNullString
.passbaru.Text = vbNullString
.ulangpassbaru.Text = vbNullString
End With
'pesan akhir
MsgBox sMsg
Wassalam.
Kid.
Saya tengah membuat aplikasi yang digunakan oleh beberapa user. Setiap user diharuskan untuk login dengan memasukan username dan password. Untuk menunjang aplikasi agar lebih user friendly maka saya ingin menambahkan menu ganti password, namun saya terkendala dalam membuat menu tersebut. Saya mencoba dengan menggunakan cara find kemudian di offset baru diganti passwornnya, namun script saya masih belum benar maklum masih belajar.
Private Sub gantipass_Click()
Dim seleksicari As Range
Dim cari As String
cari = Sheets("Sheet1").nama.Text
Set seleksicari = wspass.Range("A2:A65536")
seleksicari.Find(What:=cari, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
'sampai bagian ini belum berhasil, jd penulisan scriptnya belum dilanjutkan...
End Sub
Mohon bantuan para suhu untuk memberikan pencerahan bagaimana membuat menu ganti password tersebut.
Terima Kasih.
| ayooo... coba cari XL-mania di linkedin.com |
| tanggal 3-4 oktober yahoogroup akan mengalami maintenance. |
+-------------------------------------------------------------------+
| DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, |
| pembicaraan pribadi, one line message, melecehkan, tidak sopan. |
+-------------------------------------------------------------------+
| Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu" |
| Usahakan besar attachment < 200 kb. Gunakan winzip jika perlu. |
+-------------------------------------------------------------------+
| Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke |
| XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari |
| http://groups.yahoo.com/group/XL-mania/files/Promotion/ |
+-------------------------------------------------------------------+
| Berikan testimoni di : http://www.friendster.com/xlmania atau... |
| http://www.xl-mania.com/2008/06/testimoni-xl-mania.html |
+-------------------------------------------------------------------+
| Message lama ada di : |
| http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id] |
| http://www.mail-archive.com/xl-mania@yahoogroups.com |
+-------------------------------------------------------------------+
Nenhum comentário:
Postar um comentário