ใส่รหัสก่อนเปิดซีทดูข้อมูล

[joo]

ต้องการใส่รหัสก่อนที่ซีทต่างๆ ที่ถูกเลือกจะแสดงข้อมูลให้เห็น เช่น เมื่อคลิกที่ปุ่มหน่วยงาน A ก็จะไปเปิดซีท "A" โดยต้องกรอกรหัสก่อนถึงจะเปิดซีทได้ โดยรหัสเปิดแต่ละซีทจะไม่เหมือนกัน
- เมื่อเปิดซีทได้แล้ว ถ้าต้องการเพิ่มข้อมูลก็ให้กดปุม "เพิ่มข้อมูล" โดยต้องใส่รหัสก่อนถึงจะเพิ่มข้อมูลได้ และเมื่อกลับมาที่หน้าเมนู INDEX ก็ให้ทำการล็อคซีทของหน่วยงานนั้นไว้ โดยรหัสล็อคซีทและปลดล็อคซีทของแต่ละหน่วยงานจะไม่เหมือนกัน
-ที่ทำได้ตอนนี้คือทำการล็อคและปลดล็อคซีทได้แต่ถ้าใส่รหัสผิดมันเกิด Bug ครับ
- ที่ซีท "Report" ตรง G4 และ I4 ต้องการให้แสดงชื่อเดือนเป็นภาษาไทยและแสดงปีเป็น พ.ศ
ต้องปรับแก้ตรงไหนขอคำแนะนำด้วยครับ

[snasui]

ผมเขียนตัวอย่าง Code มาให้ตามด้านล่างครับ

Code: Select all

Sub UnprotectActiveSheet()
Dim strPassword As String
Do
    strPassword = InputBox("Enter the password for the worksheet")
    If strPassword = "" Then
        Exit Sub
    End If
Loop Until strPassword = Right(ActiveSheet.Name, 1)
ActiveSheet.Unprotect Password:=strPassword
End Sub

Sub ProtectActiveSheet()
Dim strPassword As String
    strPassword = Right(ActiveSheet.Name, 1)
    ActiveSheet.Protect Password:=strPassword
    Worksheets("INDEX").Select
End Sub

ลองปรับปรุงเพิ่มเติมเพื่อใช้กับงานจริงดูครับ

จากข้างบนการทำงานของ Code คือจะเป็นการนำอักขระสุดท้ายของชื่อชีทมาเป็น Password เมื่อคลิกปุ่มเพิ่มข้อมูลจะมี InputBox มาให้กรอก Password และหากกรอก Password ไม่ถูกก็จะขึ้นกล่อง InputBox ให้กรอกอยู่เรื่อย ๆ จนกว่าจะกรอกถูกหรือไม่กรอกเลย กรณีไม่กรอกเลยก็จะไม่สามารถปลดการ Protect ได้

หากคลิกปุ่มเมนูก็จะทำการ Protect ด้วย Password ที่เป็นอักขระสุดท้ายของชีท

ส่วนการแสดงชื่อเดือนเป็นภาษาไทยในชีท Report เซลล์ G4 คีย์

=Text(K2,"mmmm")

Enter

กรณีแสดงปีเป็นพ.ศ.ในชีท Report เซลล์ I4 คีย์

=Text(K2,"bbbb")

Enter

ดูไฟล์แนบประกอบครับ

[joo]

ขอบคุณครับที่แนะนำ ที่บอกว่านำอักขระสุดท้ายของชื่อชีทมาเป็น Password ผมลองเปลี่ยนชื่อซีทให้มีความยาวเพิ่มเช่น AN คลิกปุ่มเพิ่มข้อมูลใส่ Password "N" เกิด Bug ที่บรรดทัดนี้ครับ ActiveSheet.Unprotect Password:=strPassword

[snasui]

ชีทถูก Protect อยู่ก่อนแล้วมาเปลี่ยนชื่อชีททีหลังใช่ไหมครับ หากเป็นตามนี้เกิด Error ก็ไม่ใช่เรื่องแปลกครับ เพราะว่าตอน Protect เป็นตัว A แต่ ตอน Unprotect เป็นตัว N

ลอง Unprotect ชีททั้งหมดก่อนแล้วเปลี่ยนชื่อชีท แล้วค่อยใช้งานตามวิธีการที่ต้องการ Protect ครับ

[joo]

ทดลองปรับแก้ไขใหม่ใช้งานได้แล้วครับ แต่ตอนคลิกปุ่มเพิ่มข้อมูลอยากให้ปลดล็อคเฉพาะเซลล์ที่ต้องการได้ไหมครับ เช่น เซลล์ B7:I37 ส่วนเซลล์อื่นๆให้ล็อคไว้เช่นเดิมครับ

[snasui]

การป้องกันให้แก้ไขได้เฉพาะพื้นที่ลองตามด้านล่างครับ

Code: Select all

Sub ProtectActiveSheet()
Dim strPassword As String
On Error Resume Next
    strPassword = Right(ActiveSheet.Name, 1)
    ActiveSheet.Protection.AllowEditRanges.Add _
    Title:="Range1", _
    Range:=Range("B7:I37"), _
    Password:=strPassword
    Worksheets("INDEX").Select
End Sub

[joo]

ทดลองโค้ดตามที่อาจารย์แนะนำแล้วก็ล็อคได้ครับ แต่ว่าถ้ากลับไปที่เมนูแล้วเข้ามาใหม่ระบบจะไม่ล็อคให้
ถ้าคลิกที่ปุ่ม “เพิ่มข้อมูล”ก่อนแล้วใส่รหัสปลดล็อคระบบก็จะปลดล็อคทุกเซลล์เมื่อกลับไปที่เมนูแล้วเข้ามาใหม่ระบบก็จะล็อคให้ตามเดิม ผมลองเอาโค้ดไปวางไว้ในปุ่ม “เพิ่มข้อมูล” ระบบก็จะปลดล๊อคทุกเซลล์ใส่รหัสผิดก็จะไม่ Bug แต่ที่ต้องการคือเมื่อคลิกที่ปุ่ม “เพิ่มข้อมูล” แล้วให้ปลดล็อคเฉพาะเซลล์ที่เรากำหนดไว้เท่านั้นครับ

[snasui]

การปลด Lock เฉพาะพื้นที่เมื่อปลดแล้วและหากยังไม่ปิดไฟล์ก็จะแก้ได้ตลอดเวลา แต่เมื่อปิดไฟล์ไปแล้วเปิดมาใหม่ เมื่อจะทำการแก้ไขข้อมูลก็จะต้องใส่รหัสเพื่อปลด Lock เฉพาะพื้นที่ก่อนเสมอ

ลำดับการป้องกันแบบนี้คือ

1. กำหนดพื้นที่ที่ต้องการให้แก้ไขได้แล้วใส่รหัสป้องกันตาม Code ที่ให้ไปล่าสุด
2. ป้องกันชีทซึ่งต้องกำหนดให้สามารถเลือกเซลล์ที่มีการ Locked ได้ด้วย

ในการใช้งานตามปกติเมื่อป้องกันชีทในข้อ 2 แล้วก็ไม่ต้องปลดการป้องกันอยู่เรื่อย ๆ สามารถป้องกันรวดเดียวทุกชีทได้เลย การปลดการป้องกันก็ต่อเมื่อต้องการปรับปรุงไฟล์ เพราะผู้ใช้สามารถที่จะคีย์ข้อมูลหากกรอกรหัสที่อนุญาตให้ใช้งานตามข้อ 1 ได้อยู่แล้วครับ

[joo]

ทำตามที่แนะนำปิดไฟล์แล้วเปิดใหม่สามารถล็อคได้ตามเงื่อนไขแล้วครับแสดงว่าปุ่มสำหรับ "เพิ่มข้อมูล" ก็ไม่จำเป็ต้องมีก็ได้ใช่ไหมครับ
โค้ดด้านล่างนี้ผมลองนำมาใส่ไว้ในปุ่ม "เพิ่มข้อมูล" ทำไมถึงไม่ทำงานตามเงื่อนไขครับ
Sub UnprotectActiveSheet()
Dim strPassword As String
Do
strPassword = InputBox("Enter the password for the worksheet")
If strPassword = "" Then
Exit Sub
End If
Loop Until strPassword = Right(ActiveSheet.Name, 2)
On Error Resume Next
ActiveSheet.Unprotection.AllowEditRanges.Add _
Title:="Range1", _
Range:=Range("B7:I37"), _
Password:=strPassword
ActiveSheet.Unprotect Password:=strPassword
End Sub

[snasui]

ปุ่มเพิ่มข้อมูลไม่จำเป็นต้องใช้แล้วครับ

การนำ Code ด้านบนไปใส่ไว้ในปุ่มเพิ่มข้อมูลนั้นต้องการเป้าหมายเป็นอย่างใดครับ

ถ้าต้องการ Lock เฉพาะพื้นที่โดยใ้ช้ 2 อักขระสุดท้ายของชื่อชีทให้ใช้ Code ตามด้านล่าง ไม่ต้องใส่ Code สำหรับปลดการป้องกันชีทเข้าไปครับ

Code: Select all

Sub ProtectActiveSheet()
Dim strPassword As String
On Error Resume Next
    strPassword = Right(ActiveSheet.Name, 2)
    ActiveSheet.Protection.AllowEditRanges.Add _
    Title:="Range1", _
    Range:=Range("B7:I37"), _
    Password:=strPassword
    Worksheets("INDEX").Select
End Sub

[joo]

ขอบคุณครับเข้าใจแล้วครับ ถ้าต้องการ Copy ข้อมูลในซีท Reportไปอยูในซีทใหม่ โดยการให้โปรแกรมเพิ่มซีทก่อนแล้วค่อยนำข้อมูลไปวางได้ไหมครับ ผมเคยอ่านเจอโค้ดการเพิ่มซีทในบอร์ดแต่หาไม่เจอแนะนำหน่อยครับ

[snasui]

การเพิ่ม Sheet สามารถใช้ Code ตามด้านล่างครับ

Code: Select all

Sheets.Add

กรณีเพิ่มหลายชีท เช่นเพิ่ม 10 ชีท สามารถใช้การ Loop เข้ามาช่วยครับ เช่น

Code: Select all

Dim i as Integer
For i = 1 To 10
   Sheets.Add
Next i

หากต้องการเพิ่มชีทแล้ว Copy ข้อมูลไปวางลองประยุกต์ดูจาก Code ข้างต้น ติดขัดตรงไหนถามมาได้เรื่อย ๆ ครับ

กรณี Copy Sheet แล้ว Save เป็น File อื่นสามารถดูตัวอย่างได้ที่นี่ครับ http://www.snasui.com/viewtopic.php?p=4633#p4633

[joo]

ผมทำ Copy sheet ได้แล้วครับ แต่ว่าอยากให้คงสูตรในช่วง L7:L16 และ K16,J17 ไว้ด้วยทำได้ไหมครับ โค้ดที่ทำไว้แบบนี้ครับ
Sub CopyNewSheet()
Dim strNameSheet As String
Worksheets("Report").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.UsedRange.Copy
ActiveSheet.UsedRange.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
strNameSheet = InputBox("¡ÃسҡÃÍ¡ª×èÍàÇÔÃ줫շµÒÁ·Õèµéͧ¡ÒÃ")
ActiveSheet.Name = strNameSheet
End Sub
- การปล็ดล็อคช่วงเซลล์นอกจาก Range B7:I37 นี้แล้วผมต้องการเพิ่มเรนจ์อื่นอีก เช่น E3:G3 ทำได้ไหมครับ ผมลองแทรกเรนจ์ที่บรรทัดนี้ก็ไม่ทำงานครับ
ActiveSheet.Protection.AllowEditRanges.Add _
Title:="Range1", _
Range:=Range("B7:I37, E3:G3"), _
Password:=strPassword

[snasui]

การ Paste Formula สามารถใช้คำสั่งด้านล่างครับ

Code: Select all

.PasteSpecial xlPasteFormulas

ส่วนเรื่องการป้องกันเฉพาะพื้นที่ เท่าที่ดูก็ไม่น่าจะเกิดข้อผิดพลาด ลองส่งไฟล์ี่ที่ Update ล่าสุดมาดูครับ

[joo]

1.การป้องกันเฉพาะพื้นที่หลายจุดโค้ดทำงานได้ตามที่ต้องการแล้วครับ แต่ยังสงสัยอยู่ว่าทำไมถึงล็อคไม่ตรงตามโค้ดที่กำหนดไว้ เช่น ให้ปลดล็อคเฉพาะช่วง E3:F3 แต่กลับปลดล้อคให้ช่วง E3:G3 อย่างเช่นในซีท “BM”
2. ลองทำการ Copy ซีท “BM” แล้วเปลี่ยนชื่อซีทเป็น ซีท “AN” ใส่รหัสป้องกันแผ่นงานไว้คือ AN แต่รหัสสำหรับยกเลิกช่วงเชลล์ทำไมถึงไม่เป็น AN แต่กลับเป็นรหัส BM แทนครับ
3. เมื่อกดปุ่ม Copy ข้อมูล ถ้าไม่ใส่ชื่อซีท แต่ไปคลิกปุ่ม “OK” หรือ “Cancel” มันเกิด Bug ที่บรรทัดนี้ครับ ActiveSheet.Name = strNameSheet ถ้าใส่ If ดักไว้ เช่น
If strNameSheet = "" Then
Exit Sub
ไม่ว่าจะกด OK หรือ Cancel ระบบก็จะ Copy ข้อมูลมาให้ที่ต้องการคือต้องใส่ชื่อซีทก่อนแล้วค่อย Copy ข้อมูล ถ้ายกเลิกก็ไม่ต้อง Copy ข้อมูลมา และอยากให้คงสูตรที่ L7:L16,K16,J17 ไว้ด้วยต้องปรับโค้ดยังไงดีครับ

[snasui]

การ Copy Sheet ควรแทรก Code ยกเลิกการป้องกันก่อนครับ จากนั้นทำการ Copy และวางข้อมูล จากนั้นใส่ Password สำหรับการอนุญาตให้แก้ไขเฉพาะพื้นที่ และลำดับสุดท้ายทำการ Protect Sheet ไว้ตามเดิม

สำหรับ Code ที่ถามมาเกี่ยวกับให้ใส่ชื่อก่อนแล้วค่อย Copy และบางเซลล์ให้คงสูตรไว้อย่างเดิม สามารถดูตัวอย่างได้ตามด้านล่างครับ

Code: Select all

Sub CopyNewSheet()
Dim strNameSheet As String
    strNameSheet = InputBox("Please enter sheet name.")
    If strNameSheet = "" Then
        Exit Sub
    End If
    Worksheets("Report").Copy After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = strNameSheet
    ActiveSheet.Cells.Copy
    ActiveSheet.Cells.PasteSpecial xlPasteValues
    Worksheets("Report").Range("L7:L16").Copy
    ActiveSheet.Range("L7:L16").PasteSpecial xlPasteFormulas
    Worksheets("Report").Range("K16").Copy
    ActiveSheet.Range("K16").PasteSpecial xlPasteFormulas
    Worksheets("Report").Range("J17").Copy
    ActiveSheet.Range("J17").PasteSpecial xlPasteFormulas
    Application.CutCopyMode = False
End Sub

[joo]

ทดลองตามที่แนะนำเกิด Bug ที่บรรทัดนี้ครับ ActiveSheet.Name = strNameSheet
ผมจึงได้ย้ายไปใส่ไว้ที่บรรทัดสุดสามารถทำงานได้ดีแบบนี้ครับ
-------------- โค๊ดเดิม
Application.CutCopyMode = False
ActiveSheet.Name = strNameSheet
End Sub
แต่ก็ยังเกิด Bug ที่บรรทัด ActiveSheet.Name = strNameSheet
อีกถ้าหากใส่ชื่อซีทซ้ำกับชื่อซีทที่มีอยู่แล้ว ต้องเขียนโค๊ดดักก่อนการ Copy ยังไงดีครับ
แล้วคำถามข้อ1 และ 2 ยังสงสัยอยู่ครับอาจารย์

[snasui]

ทดลองตามที่แนะนำเกิด Bug ที่บรรทัดนี้ครับ ActiveSheet.Name = strNameSheet
ผมจึงได้ย้ายไปใส่ไว้ที่บรรทัดสุดสามารถทำงานได้ดีแบบนี้ครับ
-------------- โค๊ดเดิม
Application.CutCopyMode = False
ActiveSheet.Name = strNameSheet
End Sub
แต่ก็ยังเกิด Bug ที่บรรทัด ActiveSheet.Name = strNameSheet
อีกถ้าหากใส่ชื่อซีทซ้ำกับชื่อซีทที่มีอยู่แล้ว ต้องเขียนโค๊ดดักก่อนการ Copy ยังไงดีครับ
แล้วคำถามข้อ1 และ 2 ยังสงสัยอยู่ครับอาจารย์

จากที่ดู Code การย้ายบรรทัดไม่น่าจะมีผลครับ สำหรับคำถามที่ 1 และ 2 อธิบายไว้แล้วครับ

การ Copy Sheet ควรแทรก Code ยกเลิกการป้องกันก่อนครับ จากนั้นทำการ Copy และวางข้อมูล จากนั้นใส่ Password สำหรับการอนุญาตให้แก้ไขเฉพาะพื้นที่ และลำดับสุดท้ายทำการ Protect Sheet ไว้ตามเดิม

กรณีดักชื่อชีทว่าต้องมีการคีย์ชื่อและชื่อต้องไม่ซ้ำกับชีทที่มีอยู่แล้ว ตัวอย่าง Code ตามด้านล่างครับ

Code: Select all

Sub CopyNewSheet()
Dim i As Integer
Dim strNameSheet As String

Do
    strNameSheet = InputBox("Enter name of sheet")
Loop Until strNameSheet <> ""

For i = 1 To Worksheets.Count
        If UCase(Worksheets(i).Name) = UCase(strNameSheet) Then
           MsgBox "Please try again"
           Exit Sub
        End If
Next

    Worksheets("Report").Copy After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = strNameSheet
    ActiveSheet.Cells.Copy
    ActiveSheet.Cells.PasteSpecial xlPasteValues
    Worksheets("Report").Range("L7:L16").Copy
    ActiveSheet.Range("L7:L16").PasteSpecial xlPasteFormulas
    Worksheets("Report").Range("K16").Copy
    ActiveSheet.Range("K16").PasteSpecial xlPasteFormulas
    Worksheets("Report").Range("J17").Copy
    ActiveSheet.Range("J17").PasteSpecial xlPasteFormulas
    Application.CutCopyMode = False
End Sub

[joo]

ขอบคุณครับสำหรับโค๊ดที่แนะนำ
สำหรัยคำถามข้อ1และ2 เดิมทีผมทำแบบนี้ครับ เช่นต้องการสำเนาซีท "BM" ก็ทำการยกเลิกการป้องกันซีทออกหมดแล้วคลิกขวาที่ชื่อซีท เลือกย้ายหรือคัดลอกแล้วก็ สร้าสำเนาซีท ทำการเปลี่ยนชื่อซีทใหมเป็น "AN" จากนั้นก็ทำการป้องกันซีทรหัสคือ AN ทดลองปลดล็อคแก้ไขเฉพาะพื้นที่โดยใส่รหัสคือ AN ปรากฎว่าไม่สามารถปลดล็อคได้ต้องใส่รห้สของซีทเดิมคือ BM อาการที่เจอเป็นแบบนี้ครับ

[snasui]

อ้อ...ครับ ลองใช้ ChagePassword Method เข้ามาช่วยครับ

หลังจากปลดการป้องกัน Worksheet และ Copy มาชีทใหม่และเปลี่ยนชื่อชีทไปแล้ว ให้ลอง Run Code นี้เพื่อที่จะเปลี่ยน Password ครับ

Code: Select all

Sub ChangePassword()
    ActiveSheet.Protection.AllowEditRanges("Range1").ChangePassword _
        Password:=Right(ActiveSheet.Name, 2)
End Sub

จากนั้นทำการ Protect และทดสอบดูผลการแก้ไขเซลล์ดูครับ