macro ต่อเนื่องในชีทใหม่ทำอย่างไรครับ ??

[หิรัญ ชัยกุล]

ผมสร้างรูปแบบงานต่อเนื่องของแผ่นงานดังนี้ครับ
แผ่นงานปัจจุบันมีการตรวจจากผู้จัดการกดปุ๋มอนุมัติ === >> แมโครทำงานตามขั้นตอน 1. เรียกแผ่นงานต้นฉบับมาทำสำเนาเพื่อสร้างแผ่นงานในวันต่อไป ตั้งชื่อใหม่ว่า New. 2.คืนค่าเรียกกลับแผ่นงานต้นฉบับนำไปซ่อน 3.ทำงานที่แผ่นงานปัจจุบันลงชื่อผู้อนุมัติ ลงวันเวลาอนุมัติ และให้ล๊อคแผ่นงานโดยใส่รหัส เป็นอันจบขั้นตอนแมโคร
ปัญหาของงานนี้ก็คือ คำสั่งแมโครที่สร้างทำงานเฉพาะแผ่นงานที่ทดสอบการทำคำสั่งแมโคร ซึ่งในวันต่อไปต้องใช้แผ่นงานใหม่ที่สร้างขึ้น ผมคิดไม่ออกว่าแผ่นงานใหม่จะทำอย่างไรให้แมโครติดมาเพื่อพร้อมทำงานกับแผ่นงานใหม่ครับ
รบกวนท่านใดที่เคยสร้างงานลักษณะนี้หรือมีแนวทางการแก้ไขได้ ช่วยตอบทีครับ ผมแนบไฟล์ ตย. มาด้วยครับ

ธุรการ (1) OCT 58.xlsm

(49.78 KiB) Downloaded 20 times

[snasui]

Code ที่เขียนนั้นทำงานกับแผ่นงานใหม่ได้อยู่แล้ว ไม่ทราบว่าติดปัญหาใดหรือโปรแกรมฟ้องว่าอย่างไร

หากจะติดก็คือชื่อชีทที่ตั้งไว้เป็น New จะต้องตั้งเป็นชื่อที่ไม่ซ้ำ ไม่เช่นนั้นจะตั้งชื่อ New ซ้ำอีกไม่ได้

การตั้งชื่อชีทใหม่มีเงื่อนไขอย่างไรบ้าง ช่วยแจ้งเพิ่มเติมมาด้วยครับ

[หิรัญ ชัยกุล]

ขอบคุณครับที่เข้ามาอธิบาย
คืออย่างนี้ครับคุณ snasui
การอนุมัติของผู้จัดการในแต่ละวันทันทีที่อนุมัติแผ่นงานปัจจุบันแมโครจะสร้างแผ่นงานใหม่ ( เป็น Format ทำงานที่ยังไม่ป้อนข้อความ ) เพื่อให้หัวหน้างานใช้งานต่อไปในวันรุ่งขึ้น ลักษณะเป็นการวนลูป ที่ต้องทำลักษณะนี้เป็นเพราะมีการตั้งล๊อคชีทนั้นภายหลังการอนุมัติ จุดเรื่องการสร้างแผ่นงานใหม่ไม่ติดปัญหาใด ๆ ครับ เพราะถึงแม้ชื่อซ้ำมันก็จะสร้างเป็น New (2)
ปัญหาอยู่ที่ว่า
แผ่นงานที่สร้างใหม่ สามารถ Run แมโครได้ก็จริงแต่การกระทำของของแมโครที่เขียน คือ ให้ ลงชื่ออนุมติลงลายเซ็นต์ ==>>ลงวันเวลาอนุมัติ == >> และปิดท้ายด้วยล๊อคชีทเพื่อป้องกันการแก้ไขภายหลังการอนุมัติ ณ.แผ่นงานนั้นมันย้อนกลับไปกระทำที่แผ่นทดสอบการเขียนมาโคร
ครั้งแรก นั่นคือไม่สามารถลงชื่ออนุมติลงลายเซ็นต์ ==>>ลงวันเวลาอนุมัติ == >> และปิดท้ายด้วยล๊อคชีทเพื่อป้องกันการแก้ไขภายหลังการอนุมัติ ณ.แผ่นงานหม่ได้ครับผม
ต้องรบกวน Run Macro ที่แผ่นงานใหม่ดูครับ จึงจะรู้ว่าเกิดปัญหาขึ้นตามที่ผมอธิบายครับ
จะมีโค้ดใดเพื่อแก้ไข หรือแนวทางใดบ้างครับ คิดไม่ออก ??

Code: Select all

Sub Approve()
'
' Approve áÁâ¤Ã
'
' á»é¹¾ÔÁ¾ìÅÑ´: Ctrl+Shift+A
'
    Sheets("Master").Visible = True
    Sheets("Master").Select
    Sheets("Master").Copy After:=Sheets(4)
    Sheets("Master (2)").Select
    Sheets("Master (2)").Name = "New"
    Range("D1:H1").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Master").Select
    ActiveWindow.SelectedSheets.Visible = False
    Range("B5:M19").Select
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 1
    Selection.Locked = True
    Selection.FormulaHidden = True
    Range("I1").Select
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "20001"
    Range("K1").Select
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=NOW()"
    Range("I3:K3").Select
    ActiveWindow.SmallScroll Down:=-3
    Range("K2").Select
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Font.Size = 20
    On Error GoTo Password_error
ActiveSheet.Protect (InputBox("¡ÃسÒãÊèÃËÑÊ͹ØÁѵÔ", ""))
ActiveSheet.Protect = "e20tfl"
Password_error:
If Err.Number = 1004 Then
MsgBox "ãÊèÃËÑÊÃѺ¡è͹¡ÒÃ͹ØÁѵÔ!"
End If
End Sub

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub Approve()
    '
    ' Approve แมโคร
    '
    ' แป้นพิมพ์ลัด: Ctrl+Shift+A
    '
    '    Sheets("Master").Visible = True
    '    Sheets("Master").Select
        Sheets("Master").Copy After:=Sheets(Sheets.Count)
        Sheets("Master (2)").Visible = True
        Sheets("Master (2)").Select
        Sheets("Master (2)").Name = Format(Now, "ddmmyy\_h.mm.ss")
        Range("D1:H1").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
    '    Sheets("Master").Select
    '    ActiveWindow.SelectedSheets.Visible = False
        Sheets(Sheets.Count).Select
        Range("B5:M19").Select
    '    ActiveWindow.ScrollRow = 3
    '    ActiveWindow.ScrollRow = 1
        Selection.Locked = True
        Selection.FormulaHidden = True
        Range("I1").Select
        With Selection.Font
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
        End With
        Range("I2").Select
        ActiveCell.FormulaR1C1 = "20001"
        Range("K1").Select
        With Selection.Font
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
        End With
        Range("K2").Select
        ActiveCell.FormulaR1C1 = "=NOW()"
        Range("I3:K3").Select
    '    ActiveWindow.SmallScroll Down:=-3
        Range("K2").Select
        With Selection.Font
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
        End With
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Selection.Font.Size = 20
        On Error GoTo Password_error
    ActiveSheet.Protect (InputBox("กรุณาใส่รหัสอนุมัติ", ""))
    ActiveSheet.Protect = "e20tfl"
Password_error:
    If Err.Number = 1004 Then
        MsgBox "ใส่รหัสรับก่อนการอนุมัติ!"
    End If
End Sub

[หิรัญ ชัยกุล]

ขอบคุณมากครับ
ทำได้แล้ว ที่คุณ snasui แนะโค้ดมา
ทำให้ได้แนวทางคือ เมื่ออนุมัติให้สร้างSheet.ใหม่เพื่อนำค่าแผ่นงานที่อนุมมัตินั้นไปเก็บส่วน
แผ่นเก่าก็ให้แมโครล้างค่าเพื่อพร้อมสำหรับการทำงานใหม่
ซึ่งผมมองแต่อยากจะทำงานที่แผ่นใหม่อย่างเดียว
เป็นคำแนะนำที่มาประยุกต์ใช้ได้ดีมาก ๆ เลย
ขอบคุณมาก