menurutku masih ada satu hal yg kurang logis: sebuah sheet dgn nama tertentu
diakses; padahal sheet tsb belum ada
If LenB(sNewSheet) = 0 Then
MsgBox ("Masukan 'Nama' di Cell 'D6'")
Else
lIndex = Sheets(sNewSheet).Index
If Err.Number <> 0 Then
Err.Clear
Sheets("Master").Select
Sheets("Master").Copy After:=Sheets(Sheets.Count) ' Dicopy saat sheet terprotect
Sheets("Master (2)").Select
Sheets("Master (2)").Name = sNewSheet
MsgBox ("Masukan 'Nama' di Cell 'D6'")
Else
lIndex = Sheets(sNewSheet)
If Err.Number <> 0 Then
Err.Clear
Sheets("Master"
Sheets("Master (2)").Select
Sheets("Master (2)").Name = sNewSheet
'dst.....
variable lIndex akan diisi dgn index sebuah sheet; dimana sheet tsb BARU AKAN DIBUAT .
hal lain: Calon NamaSheet perlu di cek dulu apakah sudah ada sheet bernama 'calon nama tsb';
juga peringkasan dgn statement With - End With, selain ringkas codingnya juga, katanya, lebih
cepat jalannya.
modifikasi berikut ini belum tentu benar / terbaik tetapi sudah berusaha ke arah itu
Sub Button2_Click()
'==Copy Sheet==
Dim sNewSheet As String
Dim sht As Worksheet
Dim lIndex As Long
On Error Resume Next
sNewSheet = Range("d6").Value
If LenB(sNewSheet) = 0 Then
MsgBox "Data Nama' (Cell D6) belum diisi !", 48, "Oops !!"
Exit Sub
Else
For Each sht In Worksheets
If Lcase(sht.Name) = Lcase(sNewSheet) Then
MsgBox "Untuk Nama tsb sudah ada sheet-nya", 48, "Oops !!"
Exit Sub
End If
Next
Sheets("Master").Copy After:=Sheets(Sheets.Count)
'--hasil copy atau insert sheet baru : selalu menjadi ActiveSheet,
' jadi kita tidak perlu menebak namanya = ("Master (2)")
With ActiveSheet
.Name = sNewSheet
.Unprotect "Passkey"
.Shapes("Striped Right Arrow 2").Delete
.EnableSelection = xlUnlockedCells
.Protect "Passkey"
lIndex = .Index '<<--variable lIndex ini mau dipakai untuk apa ya??
End With
With Sheets("Master")
.Unprotect "Passkey"
.Range("d6:n6, d7:f8, d9:d10, h7:h8, d11:n11, d14:e25").ClearContents
.EnableSelection = xlUnlockedCells
.Protect "Passkey"
End With
End If
End Sub
'==Copy Sheet==
Dim sNewSheet As String
Dim sht As Worksheet
Dim lIndex As Long
On Error Resume Next
sNewSheet = Range("d6").
If LenB(sNewSheet) = 0 Then
MsgBox "Data Nama' (Cell D6) belum diisi !", 48, "Oops !!"
Exit Sub
Else
For Each sht In Worksheets
If Lcase(sht.Name) = Lcase(sNewSheet) Then
MsgBox "Untuk Nama tsb sudah ada sheet-nya", 48, "Oops !!"
Exit Sub
End If
Next
Sheets("Master"
'--hasil copy atau insert sheet baru : selalu menjadi ActiveSheet,
' jadi kita tidak perlu menebak namanya = ("Master (2)")
With ActiveSheet
.Name = sNewSheet
.Unprotect "Passkey"
.Shapes("Striped Right Arrow 2").Delete
.EnableSelection = xlUnlockedCells
.Protect "Passkey"
lIndex = .Index '<<--variable lIndex ini mau dipakai untuk apa ya??
End With
With Sheets("Master"
.Unprotect "Passkey"
.Range("d6:n6, d7:f8, d9:d10, h7:h8, d11:n11, d14:e25").ClearContents
.EnableSelection = xlUnlockedCells
.Protect "Passkey"
End With
End If
End Sub
----- Original Message -----
From: Herry Sutjipto
To: XL-mania@yahoogroups.com
Sent: Saturday, January 16, 2010 1:35 PM
Subject: ]] XL-mania [[ mengunci dan mengunci
Dear Miss Siti Vi, Mr Kid and all,
Setelah saya mendapat masukan dari miss Siti dan mr Kid beberapa kali, dan setelah saya pelajari ber-ulang2 kesalahan saya adalah:
1. Sebelum sheet "Master"dicopy ada lebih dari satu shapes didalamnya (tertumpuk/tidak kelihatan, padahal tidak diperlukan), sehingga harus didelete lebih dulu shapes yang tidak diperlukan tersebut.
2. Sebelum shapes dalam sheet copy an dihapus, terlebih dulu sheet tsb harus di unprotect, karena sheet "Master" pada saat dicopy dalam keadaan terprotect (hasil copyan terprotect).
3. Setelah proses mengcopy selesai baru diprotect lagi.
4. Begitu juga untuk sheet "Master" cells isian harus dikembalikan kosong.
Berikut ini adalah hasil VBA yang yang telah saya edit, mohon masukan apabila masih dapat disederhanakan.
===========================================================================================
Sub Button2_Click()
Dim sNewSheet As String
Dim lIndex As Long
On Error Resume Next
sNewSheet = Range("d6").Value
If LenB(sNewSheet) = 0 Then
MsgBox ("Masukan 'Nama' di Cell 'D6'")
Else
lIndex = Sheets(sNewSheet).Index
If Err.Number <> 0 Then
Err.Clear
Sheets("Master").Select
Sheets("Master").Copy After:=Sheets(Sheets.Count) ' Dicopy saat sheet terprotect
Sheets("Master (2)").Select
Sheets("Master (2)").Name = sNewSheet
ActiveSheet.Unprotect "Passkey" ' Di uncprotect sebelum menghapus Shapes
ActiveSheet.Shapes("Striped Right Arrow 2").Delete
ActiveSheet.EnableSelection = xlUnlockedCells ' Apa bisa dihapus? Belum saya coba
ActiveSheet.Protect "Passkey" ' Dikembalikan terprotect
Sheets("Master").Select ' Form isian di Master dihapus setelah dicopy
ActiveSheet.Unprotect "Passkey"
Sheets("Master").Range("d6:n6, d7:f8, d9:d10, h7:h8, d11:n11, d14:e25").ClearContents
ActiveSheet.EnableSelection = xlUnlockedCells ' Apa bisa dihapus? Belum saya coba
ActiveSheet.Protect "Passkey"
Else
MsgBox ("Nama sudah ada")
End If
End If
Sheets(sNewSheet).Select
End Sub
===========================================================================================
Terima kasih, dan maaf telah membuat problem yang harus berkali-kali saya posting ulang.
Best regards
Herry Sutjipto
From: Herry Sutjipto
To: XL-mania@yahoogroup
Sent: Saturday, January 16, 2010 1:35 PM
Subject: ]] XL-mania [[ mengunci dan mengunci
Dear Miss Siti Vi, Mr Kid and all,
Setelah saya mendapat masukan dari miss Siti dan mr Kid beberapa kali, dan setelah saya pelajari ber-ulang2 kesalahan saya adalah:
1. Sebelum sheet "Master"dicopy ada lebih dari satu shapes didalamnya (tertumpuk/tidak kelihatan, padahal tidak diperlukan), sehingga harus didelete lebih dulu shapes yang tidak diperlukan tersebut.
2. Sebelum shapes dalam sheet copy an dihapus, terlebih dulu sheet tsb harus di unprotect, karena sheet "Master" pada saat dicopy dalam keadaan terprotect (hasil copyan terprotect).
3. Setelah proses mengcopy selesai baru diprotect lagi.
4. Begitu juga untuk sheet "Master" cells isian harus dikembalikan kosong.
Berikut ini adalah hasil VBA yang yang telah saya edit, mohon masukan apabila masih dapat disederhanakan.
============
Sub Button2_Click(
Dim sNewSheet As String
Dim lIndex As Long
On Error Resume Next
sNewSheet = Range("d6").
If LenB(sNewSheet) = 0 Then
MsgBox ("Masukan 'Nama' di Cell 'D6'")
Else
lIndex = Sheets(sNewSheet)
If Err.Number <> 0 Then
Err.Clear
Sheets("Master"
Sheets("Master"
Sheets("Master (2)").Select
Sheets("Master (2)").Name = sNewSheet
ActiveSheet.
ActiveSheet.
ActiveSheet.
ActiveSheet.
Sheets("Master"
ActiveSheet.
Sheets("Master"
ActiveSheet.
ActiveSheet.
Else
MsgBox ("Nama sudah ada")
End If
End If
Sheets(sNewSheet)
End Sub
============
Terima kasih, dan maaf telah membuat problem yang harus berkali-kali saya posting ulang.
Best regards
Herry Sutjipto
__._,_.___
+-:: XL-mania ::::::::::::::::::::----------------------------------+
| Tahun baru, kejar setoran lagi... Ada lowongan jadi direktur? :D |
| http://www.facebook.com/group.php?gid=37671048001&ref=mf |
+-------------------------------------------------------------------+
| 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 |
+-------------------------------------------------------------------+
| Tahun baru, kejar setoran lagi... Ada lowongan jadi direktur? :D |
| http://www.facebook.com/group.php?gid=37671048001&ref=mf |
+-------------------------------------------------------------------+
| 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