Re: คีย์ตัวเลข 2 หลัก โดยไม่ต้องกด Enter ใน VBA
Posted: Fri Dec 23, 2011 7:01 pm
ขอบคุณครับอาจารย์
เดี๋ยวผมจะลองทำแล้วเก็บค่า Character code มาแจ้งในฟอรัมครับ ต้องขอบพระคุณอาจารย์เป็นอย่างสูงครับ 
คลังคำตอบแห่งความรู้จากคนไทย เพื่อโลกที่ต้องการเข้าใจในสิ่งเล็ก ๆ อย่างลึกซึ้ง
http://snasui.com/
Code: Select all
Option Explicit
Dim i As Long
Sub KeyEventOn()
For i = 96 To 105
Application.OnKey "{" & i & "}", "'EnterToNextCell """ & i & """'"
Next
End Sub
Sub KeyEventOff()
For i = 95 To 105
Application.OnKey "{" & i & "}"
Next
End Sub
Code: Select all
Option Explicit
Dim i As Long
Sub KeyEventOn()
For i = 96 To 105
Application.OnKey "{" & i & "}", "'EnterToNextCell """ & i & """'"
Next i
End Sub
Sub KeyEventOff()
For i = 95 To 105
Application.OnKey "{" & i & "}"
Next i
End Sub
Sub EnterToNextCell(ByVal KeyCode As Long)
Dim strText As String
Dim s As String
If Not TypeOf Selection Is Range Then Exit Sub
s = Chr(KeyCode)
Select Case s
Case "`": s = 0
Case "a": s = 1
Case "b": s = 2
Case "c": s = 3
Case "d": s = 4
Case "e": s = 5
Case "f": s = 6
Case "g": s = 7
Case "h": s = 8
Case "i": s = 9
End Select
strText = Selection.Value & s
Selection.Value = strText
Select Case Selection.Column
Case 3
'MsgBox "2"
If Len(Selection) >= 2 Then
Application.SendKeys "{ENTER}"
End If
Case 6
'MsgBox "5"
If Len(Selection) >= 3 Then
Application.SendKeys "{ENTER}"
End If
End Select
End SubCode: Select all
Option Explicit
Dim i As Long
Sub KeyEventOn()
For i = 96 To 105
Application.OnKey "{" & i & "}", "'EnterToNextCell """ & i & """'"
Next i
If (i = 46) Then
Application.OnKey "{" & i & "}", "'EnterToNextCell """ & i & """'"
End If
End Sub
Sub KeyEventOff()
For i = 95 To 105
Application.OnKey "{" & i & "}"
Next i
End Sub
Sub EnterToNextCell(ByVal KeyCode As Long)
Dim strText As String
Dim s As String
If Not TypeOf Selection Is Range Then Exit Sub
s = Chr(KeyCode)
Select Case s
Case "`": s = 0
Case "a": s = 1
Case "b": s = 2
Case "c": s = 3
Case "d": s = 4
Case "e": s = 5
Case "f": s = 6
Case "g": s = 7
Case "h": s = 8
Case "i": s = 9
End Select
strText = Selection.Value & s
Selection.Value = strText
Select Case Selection.Column
Case 3, 12
'MsgBox "2"
If Len(Selection) >= 2 Then
Application.SendKeys "{ENTER}"
End If
Case 6, 9, 15
'MsgBox "5"
If Len(Selection) >= 3 Then
Application.SendKeys "{ENTER}"
End If
End Select
End Subล
ส่วนที่เพิ่มคือโค้ด
If (i = 46) Then
Application.OnKey "{" & i & "}", "'EnterToNextCell """ & i & """'"
End IfCode: Select all
Option Explicit
Option Base 1
Dim i As Long
Sub KeyEventOn()
Dim a As Variant
a = Array(46, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105)
For i = 1 To UBound(a)
Application.OnKey "{" & a(i) & "}", "'EnterToNextCell """ & a(i) & """'"
Next i
End Sub
Sub KeyEventOff()
Dim a As Variant
a = Array(46, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105)
For i = 1 To UBound(a)
Application.OnKey "{" & a(i) & "}"
Next i
End Sub
Sub EnterToNextCell(ByVal KeyCode As Long)
Dim strText As String
Dim s As String
If Not TypeOf Selection Is Range Then Exit Sub
s = Chr(KeyCode)
Select Case s
Case ".", "`": s = 0
Case "a": s = 1
Case "b": s = 2
Case "c": s = 3
Case "d": s = 4
Case "e": s = 5
Case "f": s = 6
Case "g": s = 7
Case "h": s = 8
Case "i": s = 9
End Select
strText = Selection.Value & s
Selection.Value = strText
Select Case Selection.Column
Case 3, 12
'MsgBox "2"
If Len(Selection) >= 2 Then
Application.SendKeys "{ENTER}"
End If
Case 6, 9, 15
'MsgBox "5"
If Len(Selection) >= 3 Then
Application.SendKeys "{ENTER}"
End If
End Select
End Sub
Code: Select all
Option Explicit
Option Base 1
Dim i As Long
Sub KeyEventOn()
Dim a As Variant
a = Array(95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 110)
For i = 1 To UBound(a)
Application.OnKey "{" & a(i) & "}", "'EnterToNextCell """ & a(i) & """'"
Next i
End Sub
Sub KeyEventOff()
Dim a As Variant
a = Array(95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 110)
For i = 1 To UBound(a)
Application.OnKey "{" & a(i) & "}"
Next i
End Sub
Sub EnterToNextCell(ByVal KeyCode As Long)
Dim strText As String
Dim s As String
If Not TypeOf Selection Is Range Then Exit Sub
s = Chr(KeyCode)
Select Case s
Case "n", "`": s = 0
Case "a": s = 1
Case "b": s = 2
Case "c": s = 3
Case "d": s = 4
Case "e": s = 5
Case "f": s = 6
Case "g": s = 7
Case "h": s = 8
Case "i": s = 9
End Select
strText = Selection.Value & s
Selection.Value = strText
Select Case Selection.Column
Case 3, 12
'MsgBox "2"
If Len(Selection) >= 2 Then
Application.SendKeys "{ENTER}"
End If
Case 6, 9, 15
'MsgBox "5"
If Len(Selection) >= 3 Then
Application.SendKeys "{ENTER}"
End If
End Select
End SubCode: Select all
Option Explicit
Option Base 1
Dim i As Long
Sub KeyEventOn()
Dim a As Variant
a = Array(95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 109, 110, 111)
For i = 1 To UBound(a)
Application.OnKey "{" & a(i) & "}", "'EnterToNextCell """ & a(i) & """'"
Next i
End Sub
Sub KeyEventOff()
Dim a As Variant
a = Array(95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 109, 110, 111)
For i = 1 To UBound(a)
Application.OnKey "{" & a(i) & "}"
Next i
End Sub
Sub EnterToNextCell(ByVal KeyCode As Long)
Dim strText As String
Dim s As String
If Not TypeOf Selection Is Range Then Exit Sub
s = Chr(KeyCode)
Select Case s
Case "n", "`": s = 0
Case "a": s = 1
Case "b": s = 2
Case "c": s = 3
Case "d": s = 4
Case "e": s = 5
Case "f": s = 6
Case "g": s = 7
Case "h", "o": s = 8
Case "j", "i", "m": s = 9
End Select
strText = Selection.Value & s
Selection.Value = strText
Select Case Selection.Column
Case 3, 12
'MsgBox "2"
If Len(Selection) >= 2 Then
Application.SendKeys "{ENTER}"
End If
Case 6, 9, 15
'MsgBox "5"
If Len(Selection) >= 3 Then
Application.SendKeys "{ENTER}"
End If
End Select
End SubCode: Select all
Application.TransitionMenuKey = "\"Code: Select all
Application.TransitionMenuKey = "/"Code: Select all
Option Explicit
Option Base 1
Dim i As Long
Sub KeyEventOn()
Dim a As Variant
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.TransitionMenuKey = "\"
a = Array(95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 109, 110, 111)
For i = 1 To UBound(a)
Application.OnKey "{" & a(i) & "}", "'EnterToNextCell """ & a(i) & """'"
Next i
End Sub
Sub KeyEventOff()
Dim a As Variant
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.TransitionMenuKey = "/"
a = Array(95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 109, 110, 111)
For i = 1 To UBound(a)
Application.OnKey "{" & a(i) & "}"
Next i
End Sub
Sub EnterToNextCell(ByVal KeyCode As Long)
Dim strText As String
Dim s As String
If Not TypeOf Selection Is Range Then Exit Sub
s = Chr(KeyCode)
Select Case s
Case "n", "`": s = 0
Case "a": s = 1
Case "b": s = 2
Case "c": s = 3
Case "d": s = 4
Case "e": s = 5
Case "f": s = 6
Case "g": s = 7
Case "h", "o": s = 8
Case "j", "i", "k", "m": s = 9
End Select
strText = Selection.Value & s
Selection.Value = strText
Select Case Selection.Column
Case 3, 12
'MsgBox "2"
If Len(Selection) >= 2 Then
Application.SendKeys "{ENTER}"
End If
Case 6, 9, 15
'MsgBox "5"
If Len(Selection) >= 3 Then
Application.SendKeys "{ENTER}"
End If
End Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub