ต้องการปรับใช้โค๊ดสองโค๊ดให้เป็นเดียวกันค่ะ

[suka]

Code: Select all

Sub Pasteformula()
        Dim formBook As Workbook
        Dim i As Integer
        Dim rs As Range
        Dim rt As Range
        Set formBook = ThisWorkbook
       With formBook.Sheets("Form")
             i = .Range("Y203").Value
            Set rs = .Range("R204:X204").Resize(i)
            Set rt = .Range("G204")
            rs.Copy: rt.PasteSpecial Paste:=xlPasteFormulas
       End With
           Call Protect
End Sub

ต้องการปรับโค๊ดเพื่อใช้ร่วมกันค่ะ

Code: Select all

Sub Protect()
        With Sheets("Form")
            If .ProtectContents = True Then .Unprotect Else .Protect
            ActiveSheet.EnableSelection = xlUnlockedCells
        End With
End Sub

[snasui]

รวมกันเพื่อประโยชน์อะไรครับ

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

[suka]

อาจารย์คะ ต้องแนบไฟล์ตัวอย่างค่ะ ไม่ทราบว่าจะแนบอย่างไรค่ะ

[snasui]

คลิกที่ Attachments แล้วเลือก Add files ครับ

[suka]

เรียนอาจารย์ค่ะ

จากไฟล์แนบชีท Form เซล G204:M220 ใช้สูตรดึงข้อมูลจากชีท Products มาเป็นข้อมูลที่ใช้ประจำเมื่อคีย์ข้อมูลเสร็จก็สามารถใช้ปุ่ม Recordได้เลยค่ะ

แต่หากมีข้อมูลใหม่ใช้เฉพาะกิจ ก็ต้องปลดล็อค โดยใช้ปุ่ม "กดเพื่อแก้ไข" ใช้โค๊ดด้านล่างนี้ค่ะ

Code: Select all

Sub Protect()
        With Sheets("Form")
            If .ProtectContents = True Then .Unprotect Else .Protect
            ActiveSheet.EnableSelection = xlUnlockedCells
        End With
End Sub

และเมื่อแก้แล้วนำข้อมูลไปไว้ที่ชีทเก็บข้อมูลเรียบร้อยแล้ว ต้องการนำสูตรกลับมาใช้ใหม่ที่เซล G204:M220 โดยใช้โดด้านล่างนี้ต้องกดปุ่ม "กลับคืนค่าเดิม" ค่ะ หากต้องการปรับให้เป็นปุ่มเดียวควรปรับอย่างไรคะ

Code: Select all

Sub Pasteformula()
        Dim formBook As Workbook
        Dim i As Integer
        Dim rs As Range
        Dim rt As Range
        Set formBook = ThisWorkbook
       With formBook.Sheets("Form")
             i = .Range("Y203").Value
            Set rs = .Range("R204:X204").Resize(i)
            Set rt = .Range("G204")
            rs.Copy: rt.PasteSpecial Paste:=xlPasteFormulas
       End With
           Call Protect
End Sub

[snasui]

ลองปรับ Protect ให้ไป Call PasteFormula แทนตามตัวอย่างด้านล่างครับ

Code: Select all

Sub Protect()
    'โค๊ดนี้ใช้ป้องกันและยกเลิกการป้องกันชีทในฟอร์มบันทึกชื่อปุ่มกดเพื่อแก้ไข เลิก // ป้องกัน
    With Sheets("Form")
        If .ProtectContents = True Then
            .Unprotect
        Else
            Call Pasteformula
            .Protect
        End If
        ActiveSheet.EnableSelection = xlUnlockedCells
    End With
End Sub

[suka]

อาจารย์คะ นำโค๊ดด้านบนไปใช้ไม่ทราบทำไมถึงคำนวณนานแบบค้างค่ะ ต้องปิดไฟล์ด้วยการใช้ End Task ค่ะ

[snasui]

ลองกด F8 แล้วดูว่า Code ทำงานอย่างไร อาการค้างเป็นไปได้ว่าเกิดจากการ Run Code ซ้ำ ๆ โดย Code อื่น ไม่น่าจะเกียวกับ Code นี้ครับ

[suka]

อาจารย์คะ ลองกด F8 ไปเรื่อยๆมีการ Run Code ไปถึง Code ที่อยู่ในชีท Form ค่ะ ควรปรับ Code อย่างไรดีคะ

[snasui]

การปรับอย่างไรเป็นลำดับหลัง ลำดับแรกคือ Code ในชีท Form ที่ Code นี้กระทบให้เกิดการ Run ด้วย เขียนไว้ว่าอย่างไร ยกมาถามในฟอรัมด้วยครับ

[suka]

เมือกด F8 แล้วรันมาที่ Code ที่ชีท Form สองรอบแล้ววนกลับมารันที่ Pasteformula

Code: Select all

Application.EnableEvents = False

เริ่มที่โค๊ดบนนี้ค่ะ

Code: Select all

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$M$1" Then
    With ActiveSheet.Calendar1
            .Visible = True
            .Top = ActiveCell.Offset(0, 0).Top
            .Left = ActiveCell.Offset(0, 1).Left
            .Width = 110        ' <= ปรับความกว้างปฎิทิน
            .Height = 110       ' <= ปรับความสูงปฎิทิน
    End With
Else
        ActiveSheet.Calendar1.Visible = False
        
        Application.OnKey "{F10}", "MainCode"                     ' กำหนดให้ " บันทึกข้อมูล "โดยกดแป้นคีย์บอร์ดตามในวงเล็บปีกกา"{?*}
        Application.OnKey "{END}", "PoFormClose"             ' กำหนดให้ " ปิดฟอร์ม"
        
End If
If Not Intersect(Target, Range("D204:D219")) Is Nothing Then
        Application.SendKeys "%{DOWN}"
End If
        Application.EnableEvents = True
End Sub
Private Sub Calendar1_Click()
        ActiveCell.Value = Calendar1.Value
End Sub

[snasui]

ปรับ Code ที่ใช้การ Protect เป็นด้านล่างครับ

Code: Select all

Sub Protect()
    'โค๊ดนี้ใช้ป้องกันและยกเลิกการป้องกันชีทในฟอร์มบันทึกชื่อปุ่มกดเพื่อแก้ไข เลิก // ป้องกัน
    Application.EnableEvents = False
    With Sheets("Form")
        If .ProtectContents = True Then
            .Unprotect
        Else
            Call Pasteformula
            .Protect
        End If
        ActiveSheet.EnableSelection = xlUnlockedCells
    End With
    Application.EnableEvents = True
End Sub

[suka]

ทดสอบโค๊ดล่าสุดตัวอย่างไฟล์แนบได้ดังนีค่ะ

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

[snasui]

ตรง Pasteformula ให้ลบ Call Protect ทิ้งไปครับ

[suka]

สามารถใช้งานได้ตรงต้องการแล้วค่ะอาจารย์ ขอบพระคุณค่ะ