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.
2011/10/19 iskandar wagimin harjo prawiro <[email protected]>
> **
>
>
> 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.
>
>
>
>
