การใช้ Chexkbox รวมกับ Command Button

[Ueng999]

ลำดับการทำงาน
1.คลิก Button1 โชว์ UserFurm1
2.ติ๊กเครื่องหมายถูกที่ Chexkbox1 (Sheet1 Range C2 =1)
3.คลิก Command Button 1
การตรวจสอบที่1 ตรวจสอบ Sheet1 Range C2 =1 จะขึ้นวันที่และเวลา ที่เซลล์ที่มีค่าตรงกับเซลล์ A2 ที่ Range E พิมพ์ที่ TextBox1 จะขึ้นสิ่งที่พิมพ์ที่ (sheet 1 Renge("G"), sheet 2 Renge("H"), sheet 3 Renge("I") ) ที่มีค่าตรงกับเซลล์ A2
การตรวจสอบที่ 2 ตรวจสอบ Sheet2 Range C2 =1 จะขึ้นวันที่และเวลา ที่เซลล์ที่มีค่าตรงกับเซลล์ A2 ที่ Range E พิมพ์ที่ TextBox1 จะขึ้นสิ่งที่พิมพ์ที่ (sheet 1 Renge("G"), sheet 2 Renge("H"), sheet 3 Renge("I") ) ที่มีค่าตรงกับเซลล์ A2
และทำตามทั้งสองการตรวจสอบ
ทำได้แค่ การตรวจสอบที่1 การตรวจสอบที่ 2 ทำไม่ได้คะ ช่วยแนะนำทีคะ

[snasui]

ปรับ Code ที่ CheckBox2 เป็นด้านล่างครับ

Code: Select all

Private Sub CheckBox2_Click()
    Sheets("Sheet2").Unprotect Password:="1"
    If CheckBox2.Value = True Then Sheets("Sheet2").Range("C2").Value = 1
    If CheckBox2.Value = False Then Sheets("Sheet2").Range("C2").Value = 2
End Sub

การบันทึกข้อมูลลงในชีทที่ทำการป้องกันไว้จะต้องยกเลิกการป้องกันก่อนและต้องยกเลิกการป้องกันให้ถูกชีทครับ

[Ueng999]

การตรวจสอบที่ 2 ทำได้แล้วค่ะแต่เงื่อนไข่ไม่ทำงานรบกวนช่วยดู code ให้ทีคะ ว่าต้องแก้อย่งไร

Code: Select all

Private Sub CommandButton1_Click()
        Dim ws As Worksheet
    Dim pwd As String
    Dim r As Range
    Dim x0 As String
    Dim x1 As String
    Dim x2 As String
    pwd = "1"
    For Each ws In Worksheets
        ws.Unprotect Password:=pwd
    Next ws
    If Sheets("Sheet1").Range("C2") = 1 Then
    For Each r In Range("A3", Range("A" & Rows.Count).End(xlUp))
        If r = Range("a2") Then
           x0 = r.Offset(0, 4).Address
           x1 = r.Offset(0, 6).Address
            r.Offset(0, 4) = Now
            Sheets("Sheet1").Range(x0) = Now
            Sheets("Sheet1").Range(x1) = TextBox1.Text
            Sheets("Sheet2").Range(x1) = TextBox1.Text
            Sheets("Sheet3").Range(x1) = TextBox1.Text
            Range("c2").Select
    Selection.ClearContents
     Else
     If Sheets("Sheet2").Range("C2") = 1 Then
     For Each r In Range("A3", Range("A" & Rows.Count).End(xlUp))
        If r = Sheets("Sheet2").Range("a2") Then
           x0 = r.Offset(0, 4).Address
           x2 = r.Offset(0, 7).Address
            r.Offset(0, 4) = Now
            Sheets("Sheet2").Range(x0) = Now
            Sheets("Sheet1").Range(x2) = TextBox2.Text
            Sheets("Sheet2").Range(x2) = TextBox2.Text
            Sheets("Sheet3").Range(x2) = TextBox2.Text
                    End If
    Next r
    For Each ws In Worksheets
        ws.Protect Password:=pwd
    Next ws
    ThisWorkbook.Save
    Unload Me
                  End If
End Sub

[snasui]

เงื่อนไขใดไม่ทำงาน Code ติดขัดที่บรรทัดใด สำหรับไฟล์ทีแนบมาล่าสุด Code ที่ผมตอบไปในคราวก่อนพบว่ายังไม่แก้ไข ให้แก้ไขให้เป็น Code ล่าสุดทุกครั้งครับ

นอกจากนี้การเยื้อง Code พยายามทำให้อ่านง่าย เช่น

If กับ End If ควรตรงกัน

For กับ Next ควรตรงกับ

Do กับ Loop ควรตรงกัน

Select Case กับ End Select ควรตรงกัน

Sub กับ End Sub ควรตรงกัน

เป็นต้นครับ

[Ueng999]

แก้ไขตามคำแนะนำแล้วคะ

Code: Select all

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim pwd As String
    Dim r As Range
    Dim x0 As String
    Dim x1 As String
    Dim x2 As String
    pwd = "1"
    For Each ws In Worksheets
        ws.Unprotect Password:=pwd
    Next ws
                    If Sheets("Sheet1").Range("C2") = 1 Then
    For Each r In Range("A3", Range("A" & Rows.Count).End(xlUp))
                    If r = Range("a2") Then
           x0 = r.Offset(0, 4).Address
           x1 = r.Offset(0, 6).Address
                   r.Offset(0, 4) = Now
            Sheets("Sheet1").Range(x0) = Now
            Sheets("Sheet1").Range(x1) = TextBox1.Text
            Sheets("Sheet2").Range(x1) = TextBox1.Text
            Sheets("Sheet3").Range(x1) = TextBox1.Text
            Range("c2").Select
    Selection.ClearContents
     Else
    Next r
    For Each ws In Worksheets
        ws.Protect Password:=pwd
    Next ws
    ThisWorkbook.Save
    Unload Me
                  End If
End Sub

ปัญหาคือเมื่อเพิ่ม code

Code: Select all

   If Sheets("Sheet2").Range("C2") = 1 Then
     For Each r In Range("A3", Range("A" & Rows.Count).End(xlUp))
                    If r = Sheets("Sheet2").Range("a2") Then
           x0 = r.Offset(0, 4).Address
           x2 = r.Offset(0, 7).Address
                   r.Offset(0, 4) = Now
            Sheets("Sheet2").Range(x0) = Now
            Sheets("Sheet1").Range(x2) = TextBox2.Text
            Sheets("Sheet2").Range(x2) = TextBox2.Text
            Sheets("Sheet3").Range(x2) = TextBox2.Text
                    End If

CommandButton1 ก็ใช้ไม่ได้ค่ะ
ขึ้นแถบสีเหลืองที่ Private Sub CommandButton1_Click()

[snasui]

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

Code: Select all

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim pwd As String
    Dim r As Range
    Dim x0 As String
    Dim x1 As String
    Dim x2 As String
    pwd = "1"
    For Each ws In Worksheets
        ws.Unprotect Password:=pwd
    Next ws
    If Sheets("Sheet1").Range("C2") = 1 Then
        For Each r In Range("A3", Range("A" & Rows.Count).End(xlUp))
            If r = Range("a2") Then
                x0 = r.Offset(0, 4).Address
                x1 = r.Offset(0, 6).Address
                r.Offset(0, 4) = Now
                Sheets("Sheet1").Range(x0) = Now
                Sheets("Sheet1").Range(x1) = TextBox1.Text
                Sheets("Sheet2").Range(x1) = TextBox1.Text
                Sheets("Sheet3").Range(x1) = TextBox1.Text
                Range("c2").Select
                Selection.ClearContents
            End If
        Next r
    Else
        If Sheets("Sheet2").Range("C2") = 1 Then
            For Each r In Range("A3", Range("A" & Rows.Count).End(xlUp))
                If r = Sheets("Sheet2").Range("a2") Then
                    x0 = r.Offset(0, 4).Address
                    x2 = r.Offset(0, 7).Address
                    r.Offset(0, 4) = Now
                    Sheets("Sheet2").Range(x0) = Now
                    Sheets("Sheet1").Range(x2) = TextBox2.Text
                    Sheets("Sheet2").Range(x2) = TextBox2.Text
                    Sheets("Sheet3").Range(x2) = TextBox2.Text
                End If
            Next r
        End If
        For Each ws In Worksheets
            ws.Protect Password:=pwd
        Next ws
        ThisWorkbook.Save
        Unload Me
    End If
End Sub

[Ueng999]

ลองทำแล้วค่ะไม่ได้ค่ะ มีตัวอย่างให้ดูหรือเปล่าคะ

[snasui]

ตัวอย่างคือที่เขียนไป เป็นเพียงตัวอย่างการเยื้องเพื่อให้อ่านง่ายครับ

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

ลองลำดับมาใหม่เป็นข้อ ๆ ว่าต้องการจะทำอะไร Code ที่เขียนมานั้นติดบรรทัดใด ค่อย ๆ ถามตอบกันไปครับ

ควรถามที่ติดขัดแล้วแก้ไปทีละเปลาะครับ

[Ueng999]

ทำได้แล้ว ขอบคุณค่ะ