สวัสดีอาจารย์และเพื่อนๆ ครับ
วันนี้ผมได้ลองใช้ excel 2013 กับไฟล์ที่ปกติแล้วใช้งานกับ 2010 (สร้างด้วย 2010 ด้วยครับ) และใช้ได้อย่างดีไม่มีปัญหา แต่พอมาลองรันโค้ด
TotMainStk() ที่อยู่ในโมดูล
AboutStock โดยการกดปุ่ม "เรียกข้อมูล" ในชีท "Main" ปรากฎว่าเกิด Error ตามรูปด้านล่างนี้ครับ
- AbNormal04.gif (299.1 KiB) Viewed 73 times
(เหมือนกับว่า
Application.ScreenUpdating=False จะไม่ทำงาน เพราะหน้าจอยังกระพริบอยู่ แล้วก็ไปหยุดที่ชีท STK ทำให้เกิด error เพราะชีทนี้ Protect อยู่ ทั้งๆ ที่ในโค้ดไม่ได้มีคำสั่งอะไรให้ Activate ชีทนี้เลย)
แต่ตอนใช้งานใน v.2010 สามารถรันได้ปกติครับ ตามรูป
- Normal03.gif (253.59 KiB) Viewed 73 times
ผมลองรันโค้ดใน excel 2013 ทีละขั้นตอนแล้ว ปรากฎว่าไม่มีปัญหา แต่พอเวลากดรันด้วยปุ่ม "เรียกข้อมูล" ก็เกิดข้อผิดพลาดตามรูป ผมไม่รู้ว่าเพราะอะไร ทำไมถึงสลับไปที่ชีทอื่นได้ ทั้งๆ ที่ไม่ได้สั่งเอาไว้ ผมควรแก้ตรงไหนดีครับ
นี่เป็นโค้ดที่รันจากการกดปุ่ม "เรียกข้อมูล" ครับ
Code: Select all
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
ระหว่างการรันโค้ดด้านบน จะทำให้ 2 โค้ดด้านล่างนี้ทำงานไปด้วยครับ เป็นโค้ดที่ฝังอยู่ในชีท "STK"
Code: Select all
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: Select all
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
snasui.com ยินดีต้อนรับ 
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
โปรดทราบ 
ตอนรันทีละ step ก็ปกติดีครับ)