Snasui Excel Forum

ขอบคุณสำหรับคำแนะนำครับ

'Other code
Sheets("Main").Activate
For i = iiTem + 6 To 7 Step -1
'Other code

:D ลองเพิ่มการ Activate เข้าไปช่วยตามด้านล่างครับ
[code]
'Other code
Sheets("Main").Activate
For i = iiTem + 6 To 7 Step -1
'Other code
[/code]

ที่เกิด Error เป็นไปได้ว่าเกิดการทำงานตาม Event จึงทำให้โปรแกรมเก็บความจำว่า ActiveSheet คือชีทที่ไปทำงานมาล่าสุด เพื่อให้มั่นใจว่า Code ทำงานกับ Sheet ที่เราตั้งใจให้ทำงานจึงเพิ่มการ Activate เข้าไปช่วยครับ

อาจารย์ครับ

ผมเพิ่งดาวน์โหลด Office2013 Pro Plus x64 ตัวทดลองใช้งาน 60 วัน มาจากที่นี่
https://www.microsoft.com/en-us/evalcenter/evaluate-office-professional-plus-2013?i=1&lc=1033

แล้ว uninstall ของเดิมออก รีสตาร์ท แล้วติดตั้งตัวใหม่ลงไป ลองใช้ดูก็ยังเกิด error แบบเดิมครับ ไม่เข้าใจจริงๆ T_T
[attachment=2]excel version.png[/attachment]

[attachment=1]Same Error.png[/attachment]

ส่วนเรื่อง comment ก็ดีขึ้นนิดหน่อยครับ มองเห็นข้อความบางส่วน
[attachment=0]comment.png[/attachment]

ข้อมูลเพิ่มเติมครับ

รูป 1 ข้อความฟ้องขณะเกิด Error
[attachment=2]error1004.png[/attachment]

รูป 2 ตอนเกิด error ชีทปัจจุบันคือ STK (มาที่นี่ได้ยังไง งง :?: ตอนรันทีละ step ก็ปกติดีครับ)
[attachment=1]error01.png[/attachment]

รูป 3 เกิด error ใน [c]TotMainStk[/c] ตำแหน่งดังรูปครับ เพราะใส่คำว่า "หมด" ไม่ได้เพราะชีท STK ยังป้องกันอยู่
[attachment=0]error02.png[/attachment]

Run-time error 1004 ครับ ข้อความบอกว่าเวิร์คชีทได้รับการป้องกัน ไม่สามารถเปลี่ยนแปลงข้อมูลใดๆ ในเซลล์ได้

ผมงงว่ามันเปลี่ยนมาที่ชีทนี้ได้ยังไง เพราะให้รันในชีท "Main" ไม่ได้เขียนโค้ดให้มาที่ชีท "STK" เลย เพียงแต่ระหว่างรัน [c]TotMainStk()[/c] จะทำให้โค้ดที่ฝังในชีท "STK" ทำงานไปด้วยเพราะจะต้องไปเรียกข้อมูลสินค้าคงเหลือในชีท "STK" เพื่อมาแสดงในชีท "Main" ครับ

สงสัย คงเพราะเป็น "โปรแกรมทดลองใช้งานฟรีตลอดชีพ" แน่ๆ เลย ทำให้มีปัญหา :shock:

:D ผมทดสอบด้วย Excel 2013 64bit ไม่ติดปัญหาใด ตามภาพเคลื่อนไหวข้างบนระบบฟ้องว่าอะไรครับ

Private Sub TotMainStk()
    Dim i%, lRw%, iiTem%, sWhen!, sRem!
    Set WsStk = Sheets("stk")
    With Application
        .EnableEvents = False
        .Application.Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    With WsStk
        iiTem = .Range("a4").Value
        .Unprotect Password:="123"
        If .AutoFilterMode Then .AutoFilterMode = False
        If Not .AutoFilterMode Then .Range("n6:u6").AutoFilter
        .Protect Password:="123", AllowFiltering:=True
        .EnableSelection = xlUnlockedCells
    End With
    With ActiveSheet
        .Unprotect Password:="123"
        sWhen = Now()
        If .Range("e5") > 0 Then sWhen = .Range("e5")
        If .AutoFilterMode Then .AutoFilterMode = False
        lRw = Application.WorksheetFunction.Max _
                (7, .Range("b" & .Rows.Count).End(xlUp).Row)
        .Range("a7:p" & lRw).Clear
        'สร้างรายการสินค้า
        .Range("e5").Value = sWhen
        .Range("b7:e" & iiTem + 6).Value = WsStk.Range("b7:e" & iiTem + 6).Value
        .Range("f7:f" & iiTem + 6).Value = WsStk.Range("u7:u" & iiTem + 6).Value
        WsStk.Range("t1").Value = sWhen
        'เรียงคลัง C1
        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
        WsStk.Range("b3") = "C1"
        .Range("k7:l" & iiTem + 6).Value = WsStk.Range("j7:k" & iiTem + 6).Value
        .Range("q7:q" & iiTem + 6).Value = WsStk.Range("l7:l" & iiTem + 6).Value
        'เรียกคลัง M1
        WsStk.Range("b3") = "M1"
        .Range("m7:n" & iiTem + 6).Value = WsStk.Range("j7:k" & iiTem + 6).Value
        .Range("r7:r" & iiTem + 6).Value = WsStk.Range("l7:l" & iiTem + 6).Value
        'คัดลอกรูปแบบและสูตร
        Application.EnableEvents = False
        .Range("g3:j3").Copy
        .Range("g7:j" & iiTem + 6).PasteSpecial xlPasteFormulas
        Application.Calculation = xlCalculationManual
        .Range("g7:j" & iiTem + 6).Value = .Range("g7:j" & iiTem + 6).Value
        .Range("a2:p2").Copy
        .Range("a7:p" & iiTem + 6).PasteSpecial xlPasteFormats

        For i = iiTem + 6 To 7 Step -1
            If .Cells(i, "f").Value + .Cells(i, "g").Value + .Cells(i, "h").Value = 0 Then
                .Rows(i).Delete Shift:=xlUp
            Else
            sRem = .Cells(i, "g").Value + .Cells(i, "h").Value / .Cells(i, "e").Value
                With .Range("a" & i, .Range("b" & i)).Font
                    If sRem = 0 Then
                        .Color = vbRed
                        .Bold = True
                        ActiveSheet.Cells(i, "p") = "หมด"
                    ElseIf sRem < ActiveSheet.Cells(i, "f").Value Then
                        .Color = RGB(0, 0, 255)
                        .Bold = True
                        ActiveSheet.Cells(i, "p") = "ใกล้หมด"
                    Else
                        .Color = vbBlack
                    End If
                End With
                'If .Cells(i, "g").Value + .Cells(i, "h").Value = 0 Then .Cells(i, "p") = "หมด"
                .Cells(i, "o").Value = .Cells(i, "q") + .Cells(i, "r")
            End If
        Next i
        For i = 7 To .Range("b" & .Rows.Count).End(xlUp).Row
            .Cells(i, "a").Value = i - 6
        Next i
        .Range("a5").Value = i - 7
        .Range("c6").Select
        If Not .AutoFilterMode Then .Range("a6:p6").AutoFilter
        .PageSetup.PrintArea = "$A$1:$J$" & i - 1
        .Protect Password:="123", AllowFiltering:=True
        .EnableSelection = xlNoRestrictions
    End With
    Call ActivateEvent
    Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Calculate()
    Dim r As Range, rVis As Range, i%, j%
    On Error GoTo fnderrorout:
    If ActiveSheet.Name <> Me.Name Then Exit Sub
    'ใส่ลำดับสินค้าใหม่
    Set WsStk = Sheets("stk")
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    With WsStk
        .Unprotect ("123")
        i = .Range("a4").Value
        j = 1
        Set rVis = .Range("a7:a" & i + 6).SpecialCells(xlCellTypeVisible)
        For Each r In rVis
            r.Value = j
            j = j + 1
        Next r
        .Range("u7:u" & i).Locked = False
        .PageSetup.PrintArea = "$A$1:$K$" & i + 6
        .Protect ("123"), AllowFiltering:=True
        .EnableSelection = xlUnlockedCells
    End With
    Call ActivateEvent
    Application.ScreenUpdating = True
fnderrorout: 'จัดการข้อผิดพลาดกรณีเปิดไฟล์อื่น
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i%
    Set WsStk = ThisWorkbook.Sheets("stk")
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    If Target.Address(0, 0) = "B3" Or Target.Address(0, 0) = "T1" Then
        With WsStk
            .Unprotect ("123")
            i = .Range("a4").Value
            If .AutoFilterMode Then .AutoFilterMode = False
            .Range("o5:s5").Copy
            .Range("o7:s" & i + 6).PasteSpecial xlPasteFormulas
            .Range("f5:m5").Copy
            .Range("f7:m" & i + 6).PasteSpecial xlPasteFormulas
            With .Range("f7:s" & i + 6)
                .Value = .Value
            End With
            If Not .AutoFilterMode Then .Range("a6:u6").AutoFilter
            .Protect ("123"), AllowFiltering:=True
            .EnableSelection = xlUnlockedCells
            If ActiveSheet.Name = "STK" Then .Range("b3").Select
        End With
    ElseIf Target.Row > 6 And Target.Column = 14 Then
        Dim tR&, iP!
            With WsStk
                If Not IsNumeric(Target.Value) Then
                    MsgBox "โปรดคีย์เป็นตัวเลขเท่านั้น", vbCritical
                    Target.ClearContents
                Else
                    iP = Target.Value
                    tR = Target.Row
                    .Cells(tR, "l").Value = .Cells(tR, "s") * iP / .Cells(tR, "e")
                End If
            End With
    End If
    With Application
        .EnableEvents = True
        If ActiveSheet.Name = "STK" Then .ScreenUpdating = True
    End With
End Sub

สวัสดีอาจารย์และเพื่อนๆ ครับ

วันนี้ผมได้ลองใช้ excel 2013 กับไฟล์ที่ปกติแล้วใช้งานกับ 2010 (สร้างด้วย 2010 ด้วยครับ) และใช้ได้อย่างดีไม่มีปัญหา แต่พอมาลองรันโค้ด [c]TotMainStk()[/c] ที่อยู่ในโมดูล [c]AboutStock[/c] โดยการกดปุ่ม "เรียกข้อมูล" ในชีท "Main" ปรากฎว่าเกิด Error ตามรูปด้านล่างนี้ครับ
[attachment=1]AbNormal04.gif[/attachment]
(เหมือนกับว่า [c]Application.ScreenUpdating=False[/c] จะไม่ทำงาน เพราะหน้าจอยังกระพริบอยู่ แล้วก็ไปหยุดที่ชีท STK ทำให้เกิด error เพราะชีทนี้ Protect อยู่ ทั้งๆ ที่ในโค้ดไม่ได้มีคำสั่งอะไรให้ Activate ชีทนี้เลย)

แต่ตอนใช้งานใน v.2010 สามารถรันได้ปกติครับ ตามรูป
[attachment=2]Normal03.gif[/attachment]

ผมลองรันโค้ดใน excel 2013 ทีละขั้นตอนแล้ว ปรากฎว่าไม่มีปัญหา แต่พอเวลากดรันด้วยปุ่ม "เรียกข้อมูล" ก็เกิดข้อผิดพลาดตามรูป ผมไม่รู้ว่าเพราะอะไร ทำไมถึงสลับไปที่ชีทอื่นได้ ทั้งๆ ที่ไม่ได้สั่งเอาไว้ ผมควรแก้ตรงไหนดีครับ

นี่เป็นโค้ดที่รันจากการกดปุ่ม "เรียกข้อมูล" ครับ
[code]Private Sub TotMainStk()
Dim i%, lRw%, iiTem%, sWhen!, sRem!
Set WsStk = Sheets("stk")
With Application
.EnableEvents = False
.Application.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
With WsStk
iiTem = .Range("a4").Value
.Unprotect Password:="123"
If .AutoFilterMode Then .AutoFilterMode = False
If Not .AutoFilterMode Then .Range("n6:u6").AutoFilter
.Protect Password:="123", AllowFiltering:=True
.EnableSelection = xlUnlockedCells
End With
With ActiveSheet
.Unprotect Password:="123"
sWhen = Now()
If .Range("e5") > 0 Then sWhen = .Range("e5")
If .AutoFilterMode Then .AutoFilterMode = False
lRw = Application.WorksheetFunction.Max _
(7, .Range("b" & .Rows.Count).End(xlUp).Row)
.Range("a7:p" & lRw).Clear
'สร้างรายการสินค้า
.Range("e5").Value = sWhen
.Range("b7:e" & iiTem + 6).Value = WsStk.Range("b7:e" & iiTem + 6).Value
.Range("f7:f" & iiTem + 6).Value = WsStk.Range("u7:u" & iiTem + 6).Value
WsStk.Range("t1").Value = sWhen
'เรียงคลัง C1
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
WsStk.Range("b3") = "C1"
.Range("k7:l" & iiTem + 6).Value = WsStk.Range("j7:k" & iiTem + 6).Value
.Range("q7:q" & iiTem + 6).Value = WsStk.Range("l7:l" & iiTem + 6).Value
'เรียกคลัง M1
WsStk.Range("b3") = "M1"
.Range("m7:n" & iiTem + 6).Value = WsStk.Range("j7:k" & iiTem + 6).Value
.Range("r7:r" & iiTem + 6).Value = WsStk.Range("l7:l" & iiTem + 6).Value
'คัดลอกรูปแบบและสูตร
Application.EnableEvents = False
.Range("g3:j3").Copy
.Range("g7:j" & iiTem + 6).PasteSpecial xlPasteFormulas
Application.Calculation = xlCalculationManual
.Range("g7:j" & iiTem + 6).Value = .Range("g7:j" & iiTem + 6).Value
.Range("a2:p2").Copy
.Range("a7:p" & iiTem + 6).PasteSpecial xlPasteFormats

For i = iiTem + 6 To 7 Step -1
If .Cells(i, "f").Value + .Cells(i, "g").Value + .Cells(i, "h").Value = 0 Then
.Rows(i).Delete Shift:=xlUp
Else
sRem = .Cells(i, "g").Value + .Cells(i, "h").Value / .Cells(i, "e").Value
With .Range("a" & i, .Range("b" & i)).Font
If sRem = 0 Then
.Color = vbRed
.Bold = True
ActiveSheet.Cells(i, "p") = "หมด"
ElseIf sRem < ActiveSheet.Cells(i, "f").Value Then
.Color = RGB(0, 0, 255)
.Bold = True
ActiveSheet.Cells(i, "p") = "ใกล้หมด"
Else
.Color = vbBlack
End If
End With
'If .Cells(i, "g").Value + .Cells(i, "h").Value = 0 Then .Cells(i, "p") = "หมด"
.Cells(i, "o").Value = .Cells(i, "q") + .Cells(i, "r")
End If
Next i
For i = 7 To .Range("b" & .Rows.Count).End(xlUp).Row
.Cells(i, "a").Value = i - 6
Next i
.Range("a5").Value = i - 7
.Range("c6").Select
If Not .AutoFilterMode Then .Range("a6:p6").AutoFilter
.PageSetup.PrintArea = "$A$1:$J$" & i - 1
.Protect Password:="123", AllowFiltering:=True
.EnableSelection = xlNoRestrictions
End With
Call ActivateEvent
Application.ScreenUpdating = True
End Sub[/code]

ระหว่างการรันโค้ดด้านบน จะทำให้ 2 โค้ดด้านล่างนี้ทำงานไปด้วยครับ เป็นโค้ดที่ฝังอยู่ในชีท "STK"
[code]Private Sub Worksheet_Calculate()
Dim r As Range, rVis As Range, i%, j%
On Error GoTo fnderrorout:
If ActiveSheet.Name <> Me.Name Then Exit Sub
'ใส่ลำดับสินค้าใหม่
Set WsStk = Sheets("stk")
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
With WsStk
.Unprotect ("123")
i = .Range("a4").Value
j = 1
Set rVis = .Range("a7:a" & i + 6).SpecialCells(xlCellTypeVisible)
For Each r In rVis
r.Value = j
j = j + 1
Next r
.Range("u7:u" & i).Locked = False
.PageSetup.PrintArea = "$A$1:$K$" & i + 6
.Protect ("123"), AllowFiltering:=True
.EnableSelection = xlUnlockedCells
End With
Call ActivateEvent
Application.ScreenUpdating = True
fnderrorout: 'จัดการข้อผิดพลาดกรณีเปิดไฟล์อื่น
End Sub[/code]
และ
[code]Private Sub Worksheet_Change(ByVal Target As Range)
Dim i%
Set WsStk = ThisWorkbook.Sheets("stk")
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
If Target.Address(0, 0) = "B3" Or Target.Address(0, 0) = "T1" Then
With WsStk
.Unprotect ("123")
i = .Range("a4").Value
If .AutoFilterMode Then .AutoFilterMode = False
.Range("o5:s5").Copy
.Range("o7:s" & i + 6).PasteSpecial xlPasteFormulas
.Range("f5:m5").Copy
.Range("f7:m" & i + 6).PasteSpecial xlPasteFormulas
With .Range("f7:s" & i + 6)
.Value = .Value
End With
If Not .AutoFilterMode Then .Range("a6:u6").AutoFilter
.Protect ("123"), AllowFiltering:=True
.EnableSelection = xlUnlockedCells
If ActiveSheet.Name = "STK" Then .Range("b3").Select
End With
ElseIf Target.Row > 6 And Target.Column = 14 Then
Dim tR&, iP!
With WsStk
If Not IsNumeric(Target.Value) Then
MsgBox "โปรดคีย์เป็นตัวเลขเท่านั้น", vbCritical
Target.ClearContents
Else
iP = Target.Value
tR = Target.Row
.Cells(tR, "l").Value = .Cells(tR, "s") * iP / .Cells(tR, "e")
End If
End With
End If
With Application
.EnableEvents = True
If ActiveSheet.Name = "STK" Then .ScreenUpdating = True
End With
End Sub[/code]