วิธีกำหนดปุ่มคีย์บอร์ดให้มาโครทำงานและล้างหน้าบันทึกข้อมูล

[BTR]

ผมได้นำตัวอย่าง macro vba excel จาก link ที่อาจารย์ให้ไปใช้งานจริง
และคิดว่าการใช้ ปุ่ม End บนคีย์บอร์ด run macro สำหรับชิ้นงานนี้ บันทึกข้อมูล จะช่วยให้ทำงานง่ายขึ้น
โดยให้เคลียบรรทัดข้อมูลเฉพาะ sheet form:d2-m2 หลังกดปุ่ม End (RecordData) ด้วย

ผมลองเพิ่ม code เข้าไป ปรากฎว่าไม่สำเร็จครับ
หลังป้อนข้อมูล กดปุ่ม End บนคีย์บอร์ด ไม่เกิดผลใดๆ ข้อมูลไม่จัดเก็บให้ด้วย
เมือคลิกที่ปุ่มบนหน้า sheet ขึ้น complie error: expect end sub

assign_fn_key_end_2run_macro_vba.jpg

ผมควรแก้ไขตรงไหนบ้างครับ

ขอบคุณล่วงหน้า

[snasui]

แก้โดยการลบ Code เดิมที่เพิ่มเข้าไป เปลียนชีทให้เป็นตามชื่อชีทที่จะใช้จริง

เขียน Code ด้านล่างนี้ไว้ที่ชีท Template ครับ

Code: Select all

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.OnKey "{END}", "RecordData"
End Sub

[BTR]

ขอบคุณอาจารย์ครับ

[suka]

ขออนุญาตนะคะ

ขอความช่วยเหลือเรื่องปรับโด๊ดค่ะ ได้กำหนดให้เมื่อกดแป้นคีย์บอร์ด F10 บันทึกและนำข้อมูลไปไว้ที่สมุดงาน1 ชีท Sheet1 ปัญหาคือไม่ทราบว่าผู้ใช้กดแป้นคีย์บอร์ดอย่างไร บางครั้งมีการวางข้อมูลซ้ำมากกว่าหนึ่ง Copy ค่ะ ปรับอย่างไรเพื่อป้องการการวางข้อมูลมากกว่าหนึ่ง Copy ค่ะ ขอบคุณค่ะ

Code: Select all

Application.OnKey "{F10}", "MainCode"              
Application.OnKey "{End}", "ArFormClose"

จากโค๊ดทั้งชุดนี้ค่ะ

Code: Select all

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If (Target.Address = "$B$1" Or Target.Address = "$D$1" Or _
Target.Address = "$G$4" Or Target.Address = "$G$5" Or Target.Address = "$G$6" Or _
Target.Address = "$G$7" Or Target.Address = "$G$8" Or Target.Address = "$G$9" Or Target.Address = "$G$10") Then
    With ActiveSheet.Calendar1
    .Visible = True
    .Top = ActiveCell.Offset(0, 0).Top
    .Left = ActiveCell.Offset(0, 1).Left
    End With
Else
    ActiveSheet.Calendar1.Visible = False
    
    Application.OnKey "{F10}", "MainCode"                  ' กำหนดให้ " บันทึกข้อมูล "โดยกดแป้นคีย์บอร์ดตามในวงเล็บปีกกา"{?}
    Application.OnKey "{End}", "ArFormClose"            ' กำหนดให้ " ปิดฟอร์ม"
    
End If
Application.EnableEvents = True
End Sub

[snasui]

สามารถดักที่ Main Code โดยก่อนที่จะ Run ให้ขึ้น Message Box มาถามว่าต้องการจะ Copy ข้อมูลหรือไม่ หากผู้ใช้งานยอมรับก็จะ Copy ไปให้ หากปฏิเสธก็จะไม่ทำการ Copy ครับ

[suka]

อาจารย์คะ การเขียนดักที่ Main Code จะช่วยป้องกันการวางข้อมูลซ้ำได้ จากการบังเอิญผู้ใข้กดคีย์บอร์ดค้างได้ไหมคะ

[snasui]

ลองเขียน Code ตามที่ผมแนะนำไปแล้ว หากป้องกันการกดคีย์บอร์ดค้างไม่ได้ค่อยมาถามกันต่อครับ

[suka]

อาจารย์คะ Code Message Box ปรับอย่างไรให้ขึ้น Yes และ No ให้เลือกได้คะ

Code: Select all

If MsgBox("Are you sure that you want to Copy this workbook ? Please Confirm") Then
          Exit Sub
End If

ที่ MainCode ได้เพิ่มโค๊ดไว้ที่นี่ค่ะ

Code: Select all

 Sub SArBookShare()
        Dim formBook As Workbook
        Dim dtShare As Workbook
        Dim mr As Range
        Set formBook = ThisWorkbook
        Set dtShare = Workbooks("สมุดงาน1.xlsx")
        Set mr = dtShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
              With formBook.Sheets("TemBilling")
                      .Range("A2:W2").Resize(.Range("X1")).Copy
                      dtShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp) _
                      .Offset(1, 0).PasteSpecial xlPasteValues
                               If MsgBox("Are you sure that you want to Copy this workbook ? Please Confirm") Then
                                        Exit Sub
                                End If
                 End With
               dtShare.Save
   End Sub

[snasui]

ตัวอย่าง Code ตามด้านล่างครับ

Code: Select all

Sub MainCode()
    Dim response As Boolean
    response = MsgBox("Are you sure that you want to Copy this workbook ? Please Confirm", vbYesNo)
    If response = vbYes Then
        Application.ScreenUpdating = False
        Call SArBookShare
        Call BeenArL
        Application.ScreenUpdating = True
    End If
End Sub

[suka]

ตัวอย่าง Code ตามด้านล่างครับ

Code: Select all

Sub MainCode()
Dim response As Boolean
response = MsgBox("Are you sure that you want to Copy this workbook ? Please Confirm", vbYesNo)
If response = vbYes Then
Application.ScreenUpdating = False
Call SArBookShare
Call BeenArL
Application.ScreenUpdating = True
End If
End Sub

อาจารย์คะ ไม่ทราบว่านำ Code ที่อาจารย์ให้มาใช้ผิดขั้นตอนหรือไม่ค่ะ เมื่อรันโปรแกรมแล้วได้ Message Box ตามรูปแนบนี้ค่ะ และเมื่อกดปุ่ม Yes หรือ No ไม่แสดงผลใดๆเลยค่ะ

ความต้องการคือเมื่อกด F10 ที่แป้นคีย์บอร์ดหนึ่งครั้งให้ Copy ข้อมูลไปวางที่สมุดงาน1 ชีท Sheet1 หากเผลอกด F10 ที่แป้นคีย์บอร์ดซ้ำให้โปรแกรมขึ้น Message Box เตือนต้องการ Code ซ้ำหรือไม่ค่ะ

[snasui]

Code นั้นไม่ได้ดูว่ากดซ้ำหรือไม่ซ้ำ ถ้ากดจะถามทุกครั้ง หากผู้ใช้งานยอมรับก็จะบันทึก ส่วนหากไม่บันทึกต้องไปดูที่ Code เดิมว่าเขียนผิดพลาดอย่างไร Code นั้นไม่ได้ทำให้ Code เดิมทำงานผิดไปจากเดิม เป็นการเพิ่มขั้นตอนเพื่อให้ตอบรับหรือปฏิเสธการบันทึกข้อมูล กันการบันทึกโดยบังเอิญจากกรณีต่าง ๆ ที่อาจจะเกิดขึ้นครับ

[suka]

อาจารย์คะ สามารถเขียนให้ Code ดักการกดซ้ำได้หรือไม่คะ

ความต้องการคือเมื่อกด F10 ที่แป้นคีย์บอร์ดหนึ่งครั้งให้ Copy ข้อมูลไปวางที่สมุดงาน1 ชีท Sheet1 หากเผลอกด F10 ที่แป้นคีย์บอร์ดซ้ำให้โปรแกรมขึ้น Message Box เตือนต้องการ Code ซ้ำหรือไม่ค่ะ

อาจารย์คะ อีกคำถามค่ะ SendKeys เขียนตามนี้ต้องถูกต้องไหมคะ

Code: Select all

Private Sub Workbook_BeforeClose(Cancel As Boolean)
        Application.OnKey "{End}"
End Sub

[snasui]

Code ด้านบนประกาศตัวแปรผิดไปนิดหน่อยครับ

ให้เปลี่ยน Dim response As Boolean เป็น Dim response As Integer

ส่วน SendKeys ที่ยกมาถามเป็นการยกเลิก SendKeys ของการกดปุ่ม End หากต้องการยกเลิกก็เขียนถูกแล้วครับ

[suka]

ขอบคุณค่ะอาจารย์ สามารถเลือกว่าจะบันทึกหรือไม่บันทึกได้แล้วค่ะ

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

[snasui]

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

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

[suka]

อาจารย์คะ ที่ MainCode ลองปรับโค๊ดตามที่แนบมานี้แล้วฟ้องตามรูปแนบค่ะ ไม่ทราบว่าต้องปรับอย่างไรค่ะ

Code: Select all

Sub MainCode()
        Dim response As Integer
        Dim wb As Workbook
        Set wbShare = Workbooks("สมุดงาน1.xlsx")
        With wbShare.Sheets("Sheet1")
                i = Application.Match(r, .Range("B:B"), 0)
                If .Range("X" & i) = "Y" Then
                        response = MsgBox("Are you sure that you want to Copy this workbook ? Please Confirm", vbYesNo)
                        If response = vbYes Then
                            Application.ScreenUpdating = False
                            Call SArBookShare
                            Call BeenArL
                            Application.ScreenUpdating = True
                            Exit Sub
                        End If
                End If
        End With
End Sub

[snasui]

ในขณะ Run Code สมุดงาน1.xlsx เปิดอยู่หรือไม่ครับ

[suka]

อาจารย์คะ ขณะ Run Code ได้เปิดสมุดงาน1.xlsx ค่ะ

[snasui]

ได้ประกาศตัวแปรเอาไว้แล้วหรือไม่ครับ หากด้านบนสุดเป็นคำว่า Option Explicit จะต้องประกาศตัวแปรเสมอครับ

[suka]

อาจารย์คะ ประกาศตัวแปรแล้วรันโค๊ดฟ้องตามรูปแนบค่ะ ไม่ทราบจะปรับอย่างไรค่ะ

Code: Select all

Sub MainCode()
        Dim response As Integer
        Dim i As Integer
        Dim r As Range
        Dim wbShare As Workbook
        Dim wbShare As Workbook
        Dim wb As Workbook
        Set formBook = ThisWorkbook
        Set wbShare = Workbooks("สมุดงาน1.xlsx")
        Set r = formBook.Sheets("Form").Range("N2")
        With wbShare.Sheets("Sheet1")
                i = Application.Match(r, .Range("B:B"), 0)
                If .Range("X" & i) = "Y" Then
                        response = MsgBox("Are you sure that you want to Copy this workbook ? Please Confirm", vbYesNo)
                        If response = vbYes Then
                            Application.ScreenUpdating = False
                            Call SArBookShare
                            Call BeenArL
                            Application.ScreenUpdating = True
                            Exit Sub
                        End If
                End If
        End With
        formBook.Sheets("Form").Range("N2").Copy
        wdShare.Sheets("Sheet1").Range("X" & i) = "Y"
End Sub